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a SS phoeeee Accee a VAX COBOL ACCEPT Sageeneny’ 

IDENT = '1-018' i ! File: COBACCEPT.B32 EDIT:LGB1018 
BEGIN 
ORR R AAA ARAAAOAEAEAAAAEAAAEAAAARAERERA TETHER ARETE ERERAKREEEEeee 


ie COPYRIGHT (c) 1978, 1980, 1982, 1984 8 
ie DIGITAL EQUIPMENT 1 CORPORATION,» MAYNARD. MASSACHUSETTS. 
is ALL RIGHTS RESERVED. 


ie THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE oe * AND gd bt 
CCORDANCE W TH N THE 


} 0 
:* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 


* 
* 
® 
® 
® 
7 
® 
& 
a 
® 
ie TRANSFERRED. * 
Me 
® 
& 
® 
® 
® 
® 
® 
® 
® 


a 


i THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
- ePOkAT itn. NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


ie DIGITAL ASSUMES NO RESPONS 


IBILITY FOR THE USE OR RELIABILITY OF ITS 
't SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


See RARE AAA AAAAEAAAERAAAEEAE REAR AAA ATER ERATE EATER EREAERAAAA EAE 


WIN — 9S OONO UNSW "OOONAULS WIN OO 
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FACILITY: COBOL SUPPORT 


SSSSSSSSSSSSsSssssssssss 


| 

$e ABSTRACT: 

3 Supports the COBOL ACCEPT statement. | 

; Contains COBSSOPEN_IN to open an RMS file for input. | 
004 


ENVIRONMENT: VAX-11 User Mode | 


NOUSWN—OO@ 


ee em ee ee ee em ee ce ee ee a ee ee ed ed ed od od = = = ow = = oD 
-- 


004 AUTHOR: Rich Reichert, CREATION DATE: 16-JULY-79 
Soe MODIFIED BY: 
004 
904 1-001 = Original, | RKR 16-JULY-79 | 
Res 1-002 - Roke Coes SOREN. IN stop instead of signal on open error. 
050 1-003 - Make COBSSREAD_RMS signal COBS_EOFON_ACC if an EOF is | 
51 gaoemnperee during readin ng; 
26 Do string copy into caller's buffer via CHSCOPY instead of 
5 StRScoPY to gyoid dependency on STR$ routines. 
54 RKR 14-SEPT- 
22 !' 1-004 - Identity. file. name on bad RMS status other than EOF. 
0089 i 1-005 - Change name of symbolic LIBRARY file. RKR 1-O0CT-79 


sporaccer 
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COBSACCEPT = VAX COBOL ACCEPT Statement 


1-015 
1-016 - 
1 


1-018 - 


eB a De etd at ed ed a et 8 8 4 td 8 


1 
1 
Make module name match at | po nt. _RKR fwos” 
Change references to LIB$_INV OBS_INVA RG 

Make sensitive to names in REQ IRE Ee f te. RKR 21-0CT-79 
Improve errors signaled. RKR 21-0CT- 

Cosmet 6 changes. RKR 4 -0CT- 

paperetiye pSenmwpe. also try SYS$ logicals. 


Fix call to STRNLOG te test for SS$_NORMAL 
e SSS_NOTRAN is a success stetue). 

Add coBsact EPT gor to ri ACCEPT AT END imp=-statement. 
A ths +f ACC_SIZE, “STRINGLDSCSW.. LENGTH) bytes for ACCEPT. 
Yodeted a COBRA ht date. LB 9-Aug-81 

Removed C EPT EOF. This functionality is provided by a flag 
assed to COB ACCEPT. 

dd code in CoeSKE CEPT to check the STV2 field in the RAB to 
determine if the terminator is an perase requence. and if so, 

to return the gag o uence in the user's buffer. This was 


Gone in response PR regarding incompat ibilities between 
-74 16-FEB-82 


S80< 4 ond vAR-tt COBOL. LEB 

ia on 3 A 1 wits screen enhancements. LGB 15-AUG-83 
Code converted from Q10 calls to RMS. LGB 20-JAN-84 
Reset RABCRAB$V_ETO) bit’ ine 


OBSACCEPT. 
Added code to s{OSSSILLEGAL. TERA and COBSSDELETE KEY to handle 
a Control Z situation. 
Added a senbition to the IF statement in COBSSILLEGAL TERM that 
handles bell ringing for an illegal termina 
Put an RMS workaround in routine COBSSPARTIAL $e0. LGB 11-JUL-84 
Bug fix to COBSACCEPT - reverse IF stmt within the eg a Te F 


5 ~1984 23:54: AX-11 Bliss-32 V4.0-7 
27800-1382 ; £36:88 COBRTL.SRC COBACCEPT. 8 2:2 
int 

RG to 


Page 


| CCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 18-seo-1984 $3:76:58 yh Bliss-32 v4.0-7% Page 


# 


14-Sep-1 COBRTL.SRCJCOBACCEPT .852;2 

3 , 3 
5 : : PROLOGUE FILE 
; : REQUIRE “*RTLIN:COBPROLOG’ ; Suitches. Psects, Include 
3 : es 
; 1 1! 
3 bs 13 ; : TABLE OF CONTENTS: 
; 6 1615 1 FORWARD ROUTINE 
3 1614 1 COBSACCEPT ! Perform ACCEPT 
: 100 1615 1 COBSACC_ SC ' Perform ACCEPT with screen enhancements 
3 101 161g 1 COBSSACC_SCA_FILE. i Dealing with tiles not terminals, 
9 1617 1 ' RMS call is different 
. 1618 1 COBSSOPEN_IN ALUE, ! Open for sneus 
> 1619 1 COBSSRMS_GET : WNOVALUE, ! Perform an RMS S$GET call 
c* 1 1 COBSSRMS_PUT_BYTE : NOVALUE, ! Perform a one byte RMS $ 
s 16 1 COBSSRMS _BUFFER : WNOVALUE, ! Perform a buffer RMS $PUT 
% 1 1 COBSSCONTROL 2 : WNOVALUE, ! Handle Control 2 
3 3 16 1 COBSSPARTIAL SEQ : NOVALUE, ! Put entire escape seq in buffer 
3 109 1 1 COBSSDELETE REY : WNOVALUE, ! Delete Key processing 
3 140 1 1 COBSSILLEGAL_TE : NOVALUE, ! Look for valid terminator 
3 (11 16 1 COBSSCLEAN_UP : NOVALUE, ' Clean up before return to COBOL 
ot ee eC en 
3 at Mb + ® ; ! Format four routine 
3 13? + ; ! EQUATED SYMBOLS: 
; We 16 1 LITERAL 
3 118 16 1 NUM_UNITS = COBSK_UNIT_MAX = COBSK_UNIT_MIN + 1 ; 
ee 16 1 ! Number of units 
.:% 16 1 LITERAL 
3 = 0, : e for Display 

121 16 1 DISP 0 ' Code for Displ 
ee § 16 1 DNA = 1, ' Code for Display no Advancing 
ss 16 : 1 POS = ¢ ! Code for Positioning 
: 126 16 1 POS_DNA = 3, ' Code for ete he no Advancing 
3 12 1640 1 ACC_ADV = 4, ' Code for Accept (COBOL v3) 
3 126 1641 1 CC_DNA = 5 ' Code for Accept no Adv (COBOL v3) 
3 127 164g 1 FLAG_MASK = 15, i Mask for first four bits of 
: 128 16435 1 : perenreer FLAGS (0-3) 
3 ¥ 1644 1 V_BELL = 18° ! Bit flag for terminal bell 
. 4 1645 1 V_CONV = 32, ! Bit flag for conversion — 
at). 1o66 1 V_DEC_PT = 64, ! Bit flag for ‘Decimal Point 
2 9 1647 1 ! is Comma‘ 
3; (1 So | 1 V_NO_SIGN = 128. ' Bit flag yoofne include sign 
on 1649 1 V-PROTECT = ¢ . ! Bit flag for protection 
; «6135 1650 1 V_NO_ECHO = 51 ! Bit flag for no-echo 
am 1651 1 vZAD9 = 1024, i Bit flag for advancing(1)/ 
3; (6(Y 1636 4 ' no advancing ( 
ae 1655 1 V_COB_RPG = 2048, ! Bit flag for VAX COBOL / 
3; 139 1654 1 ' VAX RPG 
: 140 1655 1 DEL_KEY = ZX'7F*, ! Delete key 
3 «(141 16 $ 1 CZ = Zx"1A" ' Control 2 
3 166 1657 1 CARR_RET = 9. ! Parameters for routine 
; 14 1608 1 LINE_FD = 1, ! COBSSRMS_PUT_BYTE 
3 (146 1659 1 RING BELL = 2 
$145 1660 1 RMS_READER = {4 ; ! RMS uses up 14 bytes of 
; 146 1661 1! ' the buffer for header info 
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COBSACCEPT = VAX COBOL ACCEPT Statement $3: 36:88 AX-11 Bliss-32 v4.0-74 Page 4 
14-Sep-19 :10: COBRTL.SRCJCOBACCEPT.852;2 (2) 

! GUARDS 

ess sae * the ¢ assumes that COBSK_UNIT_MIN is 0 d COB_TABLE 
: e s 0, an 

665 has cals t items in it, we safeguard th nis module. : 

ge$ ZIF COBSK _UNIT_MIN NEG 0 ZTHEN ZERROR(' "Unexpected COBSK_UNIT_MIN value’) ZF 

008 ZIF COBSK- “UNIT. UMAX GTR 6 ZTHEN ZERROR("Unexpected COBSK_ _UNIT_MAX value") ZFI 

£5 | o.com 

24 on ACC_SCR INITIAL (0) ; ! Flag for COBSACCEPT 

$8 KABTRM SXABTRM_DECL, ! RMS XABTRM Control abieck 

ore KAB_ITMLST SITMLST_DECL CITEMS=2), ! Item List for XABTRM 

676 ‘+ 

67 ‘ Terminator mask. 

O78 Leave Control C, ¥, S, and Q for VMS. 

. Control I is Tab. ‘Control M is carriage Return. 


Escape key is a terminator for a VMS 


' 
' 
ENTER key has the same value as <CR> “ie Control M. 
Delete key is processed via routine COBSSDELETE KEY. 


BEES 


& 


MASK_VECTOR : BITVECTOR [160 


J 
( [TAB 
CR 
6 
1 
02 
04 
0g 


2 


Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 
Control 


VESRASLS 


oo 
co 


—o ee et a ed ot os — 4 — bs 2b bb tb 2) 2) 2» ts bd sd 3d 2) 8 2) ts ss 8 2b 8) bd ts 8 te 
Sts SS ooo ook 
~o 
ee te a ae ed od wd ed wd dd dS 


=xagecensv0e0 7d -x*™-370 ~*s8acan 


Ssesssssss 


dt —> 2 —) 2 —) 4) 2 8 a ta td te a 


oO 
oo 


hey 


3 


Delete key 


Lenn | NEWN-OODOUEN—OO 


Hs 


oe tees RONRUNONONUND OO 


MACROS: 


SSN 
oe at at ot 
ONO UE WIN oO 


' 
‘ 
‘ 
' 
MACRO COBS$S8_STVO_TERM = 12.0,8,0 1%; 


20 bytes by 8 bits 


for Arrow & PF Keys 


lternate Keypad Mode 


$S3 for Professional Keys 
CSI for Professional Keys 


Location of terminator if it 


.0-74 


4 
COBRTL.SRC cosatcéPT.8$2;2 


) 2 
‘sores COBSACCEPT = VAX COBOL ACCEPT Statement 18-se0-19 $3: 56:22 AX-11 Bliss-32 Vv 


3 1 1 ! is not an escape sequence 
3 } : MACRO COBSSB_STV2_LEN = 14,0,8,0 1%; ! Length of escape sequence 
3 1 1 —s 

; " ' ; 1 SVERIFY_ TERMINATOR = 

; '¢ 

3 "1725 #1 ! If parameter KEY not sent (.KEY = 0) then CR, TAB, CONTROL 7, 

3 : 4 $ ; and DELETE KEY are the only legal terminators. 

3 "17 1 ! If parameter KEY not 0 then CR, TAB, CONTROL Z, DELETE KEY, PF, 

: "1729 1 i ARROW and SPECIAL FUNCTION PROFESSIONAL Keys are legal terminators. 
3 Lt i 1 ! Copy terminator to ae | parameter if valid. 

3 . i 1 : } Flag LEGAL set to 1 if terminator is valid. 

: "17 i 1 BEGIN 

3 "17 1 

3 "1735 #1 IF .TERM_SIZE EQ. 1 

3 "17 1 THEN 

: "17 1 BEGIN 

; "1738 1 TERM_PTR = RAB FCOBS$B_stv0_ TERM] : 

: "1739 «1 SELECTONE .RAB CCOBS$B-STVO-TERM] OF 

3 "1740 1 SET 

3 ™ 1741 «#1 C CR ! Carriage Return 

; % 1748 1 TAB]: i Tab 

s m 1746 1 

3 ™ 1744 «1 BEGIN 

3 a1745 #1 IF .KEY NEQ 0 

3 4 Fo 1 THEN 

3 Mm 174 1 CHSMOVE ( 1, .TERM_PTR, .KEY CDSCSA_POINTER] ) ; 
: m 1748 #1 LEGAL = 1 ; 

3 m™1749 #1 END ; 

3 "1750 1 

3 m 1751 1 Ccz]: ! Control z 

3 ™ 1736 1 

3 m1753 (1 BEGIN 

: m1754 «#1 '¢ 

3 m1755 1 ! CONTROL Z hit along with data 

; ” 1796 1 i. 

; m 1757 1 IF (.FLAGS AND V_COB_RPG) NEQ 0 

3 m1758 #1 THEN 

; m 1759 #1 BEGIN ' Control Z is illegal 
: ™ 1760 1 LEGAL = 0; ' for VAX RPG 

: ™ 1761 1 TERM_SIZE = 0 ; 

3 La} 176¢ 1 END . 

3 m 17635 1 ELSE ! Special meaning for 
3 "1764 «#1 BEGIN ' VAX C L 

; "1765 #1 COBSSCLEAN_UP ( .PARAMETERS, .FLAGS ) ; 

3 M17 1 COBSSCONTROL_Z ( .UNIT, .KEY ) ; 

s "176 1 RETURN O ; 

5 m 1768 #1 END ; 

: “ 179° 1 END ; 

: ” 1770 1 

3 m 1771 #1 {C DEL_KEY ] : ! Delete key 

: * 1776 1 

: m1773 1 BEGIN 

; M1774 1 COBSSDELETE_KEY ( .PARAMETERS, .UNIT, .FLAGS ) ; 
3 ™1775 #1 NO_BELL = 1 ; : Special processing for 


(8 aa OE 
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1988 “ * $3:76:55 COBRTL .SRCJCOBAC cept B82;2 (2) 


14-Sep-19 


3 ° ! 16 } END ; ! the DELETE KEY. 
: a1 i 1 COTHERWISE) : ! Error - key not a 
; a1 1 ! legal terminator 
3 "1780 1 EGIN 

; 1781 1 LEGAL = 0 ; 

5 "17 ¢ 1 TERM_SIZE = 0 ; 

: a 3 i TES ot 

; " 7 5 END ; 

; M176 1 ELSE 

3 "17 1 If .CHARS_READ EQL 0 AND .RAB CRABSL_STS] EQL RMS$_EOF 

: mie ” 

; " 1791 . CONTROL Z hit alone 

; m1793 1 BEGIN 

$ - 1 : — AND V_COB_RPG) NEQ 0 

: s 1796 1 BEGIN ! Control : is illegal 

: "1797 #1 LEGAL = 0; i for VAX RPG 

3 . 178 \ TERM_ SIZE : 0; 

; ” 1800 1 ELSE ! Special meaning for 

: ™ 1801 1 BEGIN ' VAX COBOL 

3 * 1996 1 COBSSCLEAN_UP ( PARAMETERS "' AGS ) ; 

3 - 13 1 COBSSCONTROL 2 ( .UNIT, .KEY ) ; 

3 ™ 18046 1 RETURN O ; 

; f 1806 i END ad. 

; m 1807 ELSE 

: a1 3 1 i Escape Sequence as Terminator. 

: ” 1810 1 t= 

3 . : 12 ; oe NEQ 0 

; m 1813 1 '¢ 

3 & isi $ 1 ! COBSSCONTROL_KEY converts terminator sequences to COBOL 
3 ™ 131? 1 ' defined sequences and fills in KEY parameter if terminator 
3 . : 18 ; is legal. 

F m1 18 1 BEGIN 

3 A" i 19 1 IF NOT ( COBSSCONTROL_KEY (TERM_PTR, .TERM_SIZE, .KEY) ) 
; M1821 1 BEGIN 

3 a1 § 1 LEGAL = 0; 

3 . : ? : Le =0; 

; m 1825 1 ELSE 

3 "1 $ 1 LEGAL = 1; 

: a1 1 ND 

: ™ 1828 1 ELSE 

: "1829 1 '¢ 

3 ™ 1850 1 i KEY porenetes not passed. Escape sequences are not 
3 - \3 3 ; : _ lega terminators. 


root 
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CCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 1$-sep-19 4 23:54: AX-11 Bliss-32 V4.0-74 P 7 
ett) 14-Sep-1984 $3:35:55 ECOBRTL sre COBAL CEPT B92:2 sow (2) | 
5 3 "1833 (1 BEGIN 
3 (3 a1 1 bE GAL =0; 

: $20 mn 1835 1 RM_SIZE = 0 ; 
; 1 a1 1 END ; | 
3 § te ; : . END ; ! End SVERIFY_TERMINATOR macro 

3 4 1 § 1 

; 5 1840 1 MACRO 

3 : : : 1 : SERROR_REPROMPT s 

; :¢ 

3 a1 4 1 ! Ring terminal bell to signal a CONVERSION error was been made during 

s m 1844 =«#(1 : gore input, restore curser to original position and perform another 

: ™ 1845 1 ! $GET to look for valid data. 

fame, & 

3 ‘ 2 : : : BEGIN ! Begin SERROR_REPROMPT macro 

; 5 m 1850 1 LOCAL 

; m 1851 1 PUT_TOTAL INITIAL (0), ! # of chars to S$PUT 

5 “1 26 1 INDEX : INITIAL (0) ! Pointer to RESTORE_CURSOR 

: $s m 1855 1 RESTORE_CURSOR =: VECTOR (5006, BYTE]: § Holds sequence for restoring 

3 9 m 1854 1 ! cursor position. 

3 ? : : 2? : COBSSRMS_PUT_BYTE ( RING_BELL, .FLAGS ) ; 

3 § m 1857 1 '¢ 

3 o? 2 ; 38 : If NO ECHO was set no need to do any erasing of input data 

; 5 41 1 

3 $ m 1861 1 IF .YES_NO_ECHO EQL 0 

; tl 1308 1 THEN 

; 8 m 18635 1 BEGIN 

3 9 m 1864 1 

3 350 m 1865 1 IF (.PUT_FLAG NEQ 0) AND (.YES_PROTECT EQL 0) 

3 3) ™ 1366 1 THEN 

5 26 m 1867 1 

= m 1868 1 '¢ 

3; 354 m™ 1869 1 ! If no protection set and attributes were turned on - turn them off. 

3 339 m 1870 1 ! If protection was set, leave the FIELD on the screen. OFF_BUF holds 

3 28 m 1871 1 ! escape sequence to turn off attributes. OFF_LEN = Length of that 

: oe a1 Lf 1 ! sequence. 

; 358 "1875 1 te 

; 359 m 1874 1 

3 m 1875 1 BEGIN 

; 1 m™ 1876 1 CHSMOVE ( .OFF_LEN, OFF _BUF [0], RESTORE_CURSOR [0] ) ; 

; ¢ M1877 1 PUT_TOTAL = .OFF_LEN ; ' Total for $PUT so far 

3 "1878 1 END ; 

s "1879 1 

3 5 m 1880 1 '¢ ; . 

5 ™ 1881 1 ! Sequence for reprompting - Backspace, Space, Backspace for each input 

3 a1 § 1 ! character. 

: 369 mae 4 z 

; 370 ™ 1885 1 INDEX = .PUT_TOTAL ; ! PUT_TOTAL = 0 or .OFF_LEN 

3 4 ~ ’ } me =PUT_TOTAL TO (.PUT_TOTAL+(.CHARS_READ-1)) DO 

; oT m 1888 1 RESTORE_CURSOR [.INDEX] = BS ; ! Backspace 

3; 374 m 1889 1 RESTORE_CURSOR C.INDEX*1] = BLANK ; ! Space 


ee. — - — 


2 
OBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 18-56 -1984 23:54: AX=11 Bliss-32 V4.0-74 P # 
(obi 122800- 1984 36:33 COBRTL.SRCICOBACCEPT .B82;2 om 12) 
; RESTORE _CURSOR C.INDEX*2] = BS ; ! Backspace 
INDEX =". INDEX #3 ; 
PUT_TOTAL = .PUT_TOTAL + (.CHARS_READ®3) ; ! Total for $PUT so far 


ek lari NEQ 0) AND (.YES_PROTECT EQL 0) 


'¢ 
! If no protection set and attributes used - turn them on again. 
! (after deleting all characters from screen). ON_BUF holds escape 


sequence to turn on attributes. ON_LEN - length of that sequence. 


Beer ae eSSSSESEeses 


: “1 1 

3 a1 1 

3 a1 1 

3 “1 1 

3 “1 1 

3 “1 1 

3 a1 1 

$ “1 1 

3 a1 1 

3 a1 1 

$ a1 1 

3 a1 1 

: 386 m 1908 4 “a 

; 389 a1 1 BEGIN 

; 390 “1 1 CHSMOVE ( .ON_LEN, ON BUF [0], RESTORE_CURSOR C.PUT_TOTAL] ) ; 

: 391 a1 1 PUT_TOTAL = .PUT_TOTAC + .ON_LEN ; ! Total for $PuT 

: 3 a1 1 END; 

3 y a1 1 

3; 394 a1 1 END ; 

i 36 mio) dts 

; 39 Lal bat 1 ! Max for SPUT buffer is 1024 (can be increased by changing the max on 

; 398 4 191 1 ' a@ SYSGEN parameter). If user input 500 characters the total sequence 

; 399 m1914 #1 ! for reprompting would be 1500 bytes plus possible sequences for turning 
; 400 ™1915 1 ! attributes off and on ogere therefore perform a $PUT in sets of 1024 

3 $3) z a ; until the whole buffer ESTORE_CURSOR has been written to terminal. 

; 40 "1918 1 

BRT toc 

; 406 ™1921 1 TOT, ' Length of $PUT. 

; 607 419 ¢ 1 LAST_WRITE : INITIAL (0) ; ' = 1 for final $PUT - 
; 4608 419 1 ! $PUT Less than 1024 bytes 
; ret - : : wnig LAST _URITE EQL 0 DO 

: rth . 1? $ : a atte GTR (COBSK_ACC_SIZE = RMS_HEADER) ! COBSK_ACC_SIZE = 1024 
: tig ™1928 1 BEGIN ! Need multiple SPUTs. ; . 
3 64616 "1929 1 P_TOT = COBSK_ACC_SIZC = RMS_HEADER ; ! # to Write to screen this time. 
3: 4415 m™ 1930 1 POT_TOTAL = .PUT_TOTAL - .P_TOT ; ! # still to Write. 

: 29 m 1982 4 evsee 

: 418 “ 1988 1 BEGIN ! Final $PUT 

s 61 a 19 1 P_TOT = .PUT_TOTAL ; 

: 420 m 1935 1 LAST_WRITE ="1 ; 

: 421 "19 1 END 3 

: 6 § "19 1 END; 

; 2 m 1939 | ‘6 

: 4 ¢ ™ 1940 1 ' Clear screen of invalid input 

ie tii * 

: 628 M 1908 1 COBSSRMS_PUT_BUFFER ( RESTORE_CURSOR [0], .P_TOT, .FLAGS ) ; 

; 4629 M1944 1 END ; 

; 6 m 1945 1 

: 6 m 1946 1 


w 
— 
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eit heal aanaeg sap agen Poco Tnceaceamman 1-90-19 13:70:38 ECbart.°sreScosaccepr.8 oe (2) 
; : ¢ e of ! ¥ Perform another $GET = Looking for valid input 
- M1969 1 ‘ 
; R -COBSSAL_WRITE_RAB C .UNITCO) J F 
: t 2 “ 13 COBSSRAS GET (.RAB, .FUNC_VAL, -ACC_SIZE, -PUT_HERE CDSCSA_POINTER] ) ; 
; ; 3 : DY § : REPROMPT_DONE = 1 ; : A on that REPROMPT * been 
: 440 m 1955 1 END ; i End of SERROR_REPROMPT macro 
ee: eae 
: MACR 
; bee “ 1986 : $81ND_PARAMETERS = 
St? ' i f data. 
of the subroutines in a vector o 
: te a 1962 i BIND att sah thaw names that can be used to identify the 
: 648 Lt 1968 : ' various elements of the vector. 
: 449 M 1964 in 
: 430 A ieee _— : BLOCK C,BYTEJ ! Buffer to hold input 
: 133 a 1967 i NEXT ERAR : PARAMETERS £83 : VECTOR ¢,BYTES, : Butter used for 
: 63 A ies 4 . : WORD i Length for RMS $GET 
: tee a 1990 i CHARS READ = PARAMETERS i. “- + Sester ot Seous qherectors | 
; re 1973 : amet: agpagtsiaaey ose. i in the item ites for RMS $GET 
: ' Size of terminator 
: 486 " 1378 i TERMTLOC 2 PARAMETERS 2 ’ ! Location of terminator 
: te0 " 1998 1 TERM PTR = PARAMETERS (11], } Ag | qeresenae? ree 
Py - F erm - 
: te a 1999 1 TERMTEROM DEL > PARAMETERS ig : cieg tree tepsersee aunt to 
: $6 Aion 4 : ‘i i = 0 if illegal terminator hit 
: 088 1980 4 YES PROTECT 2 PARAMETERS 13 : i = 1 if PROTECTED requested 
: ios 1 YES DEFAULT = PARAMETERS [16], ! = 1 if DEFAULT used as input 
4 1e$ " 1982 1 PUT" FLAG = PARAMETERS (17), : Flag tor re a on 
3 468 " 1988 OF F “BUF = PARAMETERS [18]. : VECTOR C,6YTEJ, | Holds es aftr ibutes 
: 470 M 1986 : . OFF _LEN = PARAMETERS (21) ; ! Length of esc seq in OFF_ 
Oy ag . 
; a78 1988 : The following tables convert the UNIT number into a logical name. 
: oh 199) ttt esc ca) = UPLIT BYTECZASCIC A) = BASE 4: 
: 477 1992 1BIND ~ 
: £78 1998 1 BASE = UPLIT(REP 0 OF (0)), 
3 479 1994 1 COB_TABLE = UPLIT ¢ 
: 430 1996 DESe=(COBSOUTPUT*S 
it 1997 | DESC~(*COBSCONSOLE’S,_ 
; 48 1998 1 DESC-(*COBSCARDREADER'), 
; 484 1998 1 Beat f  COBSPAPERTAPEREADER De 
: Be oo DESC= (*COBSPAPERTAPEPUNCII")): VECTORCNUM_UNITS), 
: YS_TABLE = UPLI 
: tb $08 i ‘ “DESC_(*SYSSINPUT"), 
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-5ep-1984 
489 DESC_("SYSS$OUTPUT"), 
150 5 DESC-("*SYSSERROR'), 
491 DESC?(*SYSSINPUT®}. 
49 DESC” (*SYS$INPUT') 
49 DESC-("SyS$ouTPUT'S 
4 DESC-("SYSS$OUTPUT")5: VECTORCNUM_UNITSJ; 


; EXTERNAL REFERENCES: 


EXTERNAL ROUTINE 


OBSSCONTROL KEY, 
OBSSACC_ CONVERT, 
08$$0 : 


IBSSTOP : 
IBSGET_VM, 
IBSFREE_VM, 
TRSGET1_DX 
TRSDUPL~ CHAR, 
STRSFREET DX, 
TRSCOPY_R 
COBS$SETOP 


ANKE LCKCOOO 


“TERM_TYPE, 
COBSSSET_ATTRIBOTES_ONLY ; 


EXTERNAL LITERAL 
-ERRDURACC, 
“FAIGET_VM, 
COBS_EOFON ACC, 
COBS_ INVDEFVAL, 
COBS_INVARG ; 


' Translate terminator 
!' Conversion routine 

! Open for output 

! Signals fatal error 
' Get virtual memory 

' Free virtual memory 
' Allocate a pres 

' Duplicate character n times 
! Deallocate a string 
! Copy a string by ref 
4 ty: terminal type 
' Set bo 

! underline 


! Error during DISPLAY 
! Failure to get VM 

' EOF on ACCEPT 

! DEFAULT value too Large 
! Invali¢ Argument (s) 


ld, reverse, blink, 
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EXTERNAL 
COBSSAL_WRITE_RAB : VECTOR, ! Address of RAB 
r4 § 38 COBSSAW_WRITE IF I : VECTOR C,WORDJ], ! Internal file identifiers 
2 39 COBS$AB_USPCOBE : VECTOR C,BYTEJ, ! Prefix and Post upspacing 
2 2040 COBSS$AB_PREV VECTOR C,BYTEJ, ! History of previous call 
2 2041 COBSACC TERM_TYPE, ! Terminal type for ACCEPT 
2 2042 COBSTERA_TYPE; ! Terminal type for DISPLAY 


2 

SACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 13-se -1984 23:54: AX-11 Bliss-32 V4.0-74 Pa 11 
itt EOBSACCEPT - iorolan ACCEPT Statement 12-88-18 ; 36:35 COBRTL. aeicopatcépr 8$2:2 - (3) 
; 3 1 SSBTTL *COBSACCEPT = Version 1 ACCEPT Statement’ 
; ¢ } GLOBAL ROUTINE COBSACCEPT (UNIT, STRING) = 
: 1 '44 
; : 5 ' FUNCTIONAL DESCRIPTION: 
: 5 rk 7! Reacs a record from specified unit and delivers record to 
3 bey ; caller's string. 
; 9 p26 ; FORMAL PARAMETERS: 
; 540 054 1! UNIT. rbu.va Syte integer unit number designating the unit from 
; a5 055 1! which the string is to be read, followed by byte 
3 ¢g B26 ,: flag indicating whether routine should (false) abort, 
3 ei F ; } or (true) return status on RMSS_EOF. 
3 a8 $39 1! STRING. wt.ds The address of a fixed-string descriptor to 
; 546 060 1! receive the string read. 
; 547 061 1! 
; 548 B06 1 ! IMPLICIT INPUTS: 
>; 549 065 1! 
; 220 See ; Status of whether the file in question is currently open. 
: 226 +4 1 ! IMPLICIT OUTPUTS: 
; 55 067 1! 
; 554 068 1! Updated status of the file just used. 
3 399 069 1! 
3 330 070 1 ! ROUTINE VALUE: 
3 Sor O71 1! 
; 558 Bre g If .UNITC1) is false: 
: 559 073 1! Unspecified. 
; 560 2074 1! 
; 561 sone Zz If .UNITC1) is true: ; 
3 206 O76 ' Either true or false, indicating success or EOF, respectively. 
; 564 078 1! SIDE EFFECTS: 
$ 20? 079 1! ; 
; 566 080 1! Reads a record from the designated unit. 
3 Ser 081 1! ‘ 
; 568 ORs 1 !-- 
; 569 083 1 
; 570 084 BEGIN 
; 23) bBo os UNIT VECTORE ,BYTE) 
; 38 0 STRING: REF BLOCK(8, BYTE); 
; 574 088 
ore 089 LOCAL 
; 376 090 RAB: REF $RAB_DECL, 
s 37 091 US, 
; 278 O38 DESCR: BLOCK (8, BYTE), 
; 579 09 TERM_SIZ 
; 380 094 BUFFER: VECTOR CCOBSK_ACC_SIZE, BYTE); 
; $8 096 IF .UNITCO) GTRU COBSK_UNIT_MAX 
; 58 09 
3; 584 4 LIBSSTOP(COBS$_INVARG) ; 
; 585 9 


ss 


COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 
Pitt CoBs. io 


° 
cE 1S-se -1984 23:54: AX-11 Bliss-32 V4.0-7 
ACCEPT = Vers ACCEPT Statement 14 et 7 ( 76:35 RO 


4 
COBRTL. COBACCEPT .852;2 


! If this file is not open, epee it. 
as second parameter to COBSSOPEN_IN signifies that VAX COBOL is used. 


if .COBSSAL_WRITE_RABC.UNITCO]] EQL 0 
THEN 


Wr: 


IF_.UNITC1) 
THEN RETURN 0 
ELSE COB$ EOFON_ACC 
ELSE COBS_ERRDURACCY 
1, .RAB+RABSC“BLN, .RABLRABSL_STS], .RABCRABSL_STV)); 


IANA 


'¢ 
! Check if the terminator size is greater than 1. If it is, 
! this indicates that the terminator string is an escape sequence. 


3 1 

3 1 

7 } 

; 1 

: 4 : 5 COBSSOPEN_IN(.UNITCOJ, 0); 

; 9 199 ! Perform a Linefeed when a Version 1 ACCEPT statement follows a 
: 535 + ; Version 3 ACCEPT statement with advancing. 

: 59% 110 if .COBS$AB_PREV [0] EQL ACC_ADV 

4 BH 1] THEN COBSSRAS_PUT_BYTE ( LINE_FD, 0) ; 

3 200 8 } Read a record into our buffer or caller's buffer, whichever is larger. 
: 601 115 RAB = .COBSSAL_WRITE_RABC.UNIT(COI); 

: 60 116 IF .STRINGCOSCSW_LENGTH) GTRU COBSK_ACC_SIZE 

: BO 118 THEN BEGIN 

: 605 119 RABCLRABSW_USZ] = -STRINGEDSC$W_LENGTH]; 

; 606 120 RABLRABSL_UBF) = .STRINGLDSCS$A_POINTER); 

Be 

: 609 13 BEGIN 

; 610 124 peat nent tat = COBSK_ACC_SIZE; 

; 611 125 RABCRABSL_UBFJ = BUFFER; 

: Sig 159 mee 

: 614 128 1+ 

; 615 129 § ! Turn off RAB CRABSV_ETO] just in case a ‘screen enhancement aon 
; 616 130 ! was performed before this one. COBSSRMS_GET set RAB CLRABSV_ET9 
; 617 13 ! to signal to RMS to expect an ‘extented Eerminal’ $GET. Here we 
3; 618 1 § ! only want a simple SGET with no bells and whistles. If RAB CRABS$V_ETO] 
: 61? 137 } is not turned off unwanted behavior will result. 

; 631 13 i CRAB$V_ETO) 0 

F $55 139 oe 

3 oee 133 Read the record. 

; 626 sat WHILE SGET(RAB = .RAB) EQL RMS$_RSA DO SWAIT(RAB = .RAB); 

; ro 148 

; 6 143 IF Not -RABCRABSL_STSJ 

; 145 LIBSSTOP( 

3 146 (IF .RABCRABSL_STS] EQL RMSS$_EOF 

A 147 THEN 

: re 

3 14 

: 150 

: Ht 

: 1 

18% 

s 155 

3 156 


FFF 
moO 0a~ 
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SACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 1-532 -19 254: AX-11 Bliss-32 V P 13 
ett EDBSACCEPT = Versioned ACCEPT Statement 12-8ee=19ke 2:16.55 Ledarte sreicopatcéor 6$2;2 me 
3 ? 135 i. Return the entire escape sequence in the user's buffer. 
: 665 1 
; ore 199 TERM_SIZE = .RABCRABSW_STV2]; ! Get terminator size 
: 648 16 CHSCOPY ( ot TERM SIZE GTR | 
; 649 188 -RABCRABSW =RSe - TERM_SIZE 
3 609 164 .RAB RABSU ~RSZ 
; $3) 19? RABLRAB Ler ee we” LS tee LENGTH], .STRINGCDSCSA_POINTER)); 
; £2 16 ‘6 
3 $28 168 ' VAX COBO Version 1 / Version 3 interaction. 
; 655 16 ! Interaction with COBSACC_SCR = Perform a Carriage Return if necessary 
3 626 109 ! and signal that this is am ACCEPT with advancing. 
: 658 17 . 
; 659 17 4 -ACC_SCR 
; 660 174 THEN 
; 661 175 COBSSRMS put Bye ( CARR_RET, 0) ; 
: 66¢ 176 COBSSAB _PREVEO = ACC_ADV ; 
3; 66 177 
3; 664 178 RETURN 1; : 
3; 665 179 1 END; ' End COBSACCEPT 
-TITLE COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statem 
; n 
-IDENT \1-018\ 
-PSECT _COBSDATA,NOEXE, PIC,2 
00000000 00000 ACC_SCR:: oe 
00004 XABTRM: .BLKB % ; 
00028 XAB AEE 79 
OD FS FF £6 00044 MASK_VECTOR® | 
BYTE -10 “11, 13 : 
00# 00048 “BYTE oti) ; 
80 B02? -BYTE <-128 : 
00 00054 -BYTE O : 
80 00055 -BYTE <-128 : 
00 00028 -BYTE 0 : 
08 0005 -BYTE 8 3 
-PSECT _COBSCODE,NOWRT, SHR, PIC,2 
0000 P.AAA: .BLKB 0 
54 55 50 3 49 24 4 4F 4 9 Q0000 P.AAC: .ASCII <9>\CCBSINPUT\ > 
54 55 29 54 55 4F 4 42 GF & A OOA P.AAD: .ASCII <10>\COBSOUTPUT j 
45 4 4F 5 4 4F $3 4 4 GF 4 B 015 P.AAE: .ASCII <11>\COBSCON é 
52 45 464 41 & 38 44 52 41 4 4 4 4F 4 0 021 P.AAF: .ASCII <14>\COBSCARDREADER\ F 
52 45 50 41 54 52 45 50 41 50 3 ? rel a3 i B8 4 P.AAG: .ASCII <19>\COBSPAPERTAPEREADER\ : 
45 54 4€ 49 52 50 45 4E 49 4C 4 42 4F 43 Of oneg P.AAH: .ASCII <15>\COBSLINEPRINTER\ : 
50 45 50 41 54 52 45 50 41 50 24 42 4F 43 38 ie P.AAL: .ASCII <18>\COBSPAPERTAPEPUNCH\ : 
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48 43 4E 55 

00000044 00000030 00000021 00000015 O0000000A 68 68 
54 


49 24 
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45 
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00000087 O00000AD O000000A3 00000099 0000008E St 
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P.AAB: .LONG 0, 10, 21, 33, 48, 68, 84 
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<10>\SYSSOUTPUT\ 
132, 142, 153, 163, 173, 183, 194 


BASE= P.AAA 
£08. TABLE= .° aa 
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0B$_E SET AY .. Coas. PAIGET vm 
OBS~ ~EOF ON AGE. COBS~ INVDEF VAL 
E OBS" INVARG, COBSSAL~ “URITE RAB 
-EXTRN COBSSAW_WRITE_IFI 
-EXTRN COBSSAB_ Use PCObE 
-EXTRN COBS$AB-PREV, COBSACC_TERM_TYPE 
*EXTRN COBSTERR ERA_TYPE, SYSSSET 
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m 
=< 
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00FC 00000 .ENTRY COBSACCEPT, Save R2,R3,R4,R5,R6,R7 
MOVAB COB$$AB PREV, R7 
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242 bytes, Routine Base: 


3 Routine Size: 
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3 
| FoRsaccert COBSACCEPT = VAX COBOL ACCEPT Statement 18-sep-19 ; 36:66 AX-11 Bliss-32 yh ap 
| 18 COBSACC_SCR = ACCEPT with screen enhancements 14-Sep-19 :10: COBRTL .SRCJCOBACCEPT.852;2 
3 667 1 1 ZSBTTL *COBSACC_SCR = ACCEPT with screen enhancenents. 
3 oo8 1 1 GLOBAL ROUTINE COBSACC_SCR ( UNIT : VECTOR ; BYTE) 
3 999 ' ¢ } STRING DEST : REF SSTRSOESCRIPTOR, 
3 34 ; : : erreur : REF SSTRSDESCRIPTOR, 
3; Of 1 1 KEY REF SSTRSDESCRIPTOR, 
: 6746 1 1 LENGTH 
3 679 1 1 de 
3 org 1 1 
; 67 1 1 lee 
3 ore 13) : FUNCTIONAL DESCRIPTION: 
; 680 198 ' | Performs COBOL ACCEPT statement with screen enhancements. 
; 681 LP : : orate © pesore from a specified UNIT and deposits record in 
; oss 196 1! A call to COBSPOS_ACCEPT is made by the VAX COBOL Compiler 
3 yy 3 3 prior to the call to COBSACC_SCR to set cursor position and 
; 685 198 1! perform any screen er Line erasing. 
; 686 199 1! 
3 one sf : CALLING SEQUENCE: 
; 689 4 1? RETURN_STATUS.wic.w = COBSACC_SCR ( UNIT. rbu.va, STRING _DEST.mt.ds, 
: 690 03 1! oes -clu.¥3 CDEFAULT.rt.dxJ, 
; O96 0s 1! LENGTH.wlu.r) ) 
; 69 oS 1 ! FORMAL PARAMETERS: 
> 694 =a 
; 695 08 1! UNIT. rbu.va ag | of two unsigned byte integers. 
; 696 09 1! The first byte is the unit number designating the 
; 697 10 1! device from which the sere is to be read. 
; 698 > ee The second byte indicates whether the routine should 
3 14 \¢ 2 abort or return to the calling oe ram. 
: 760 13 17! Byte 2 = 0 = routine will abort on control z 
3; 701 141! and reprenps on conversion errors. 
; 70 16 1! = 1 = ( AT END ) 
; 1g 7? routine will return to calling program 
3; 706 21 ss on control z and reprompt on conversion 
; 705 sig 1! errors. 
; 706 19 1! = 2 - ( ON EXCEPTION ) } 
: 707 220 1! routine will return to calling program 
3 A's $3 : on control z and conversion errors. 
; at 5 ' STRING_DEST.mt.ds Address of descriptor to receive the read input. 
3 ats 5 ' FLAGS.rlu.v Screen enhancement flag; 
3; 714 $ 1! bit 0 = bold 
3 2S : '? bit 1 = reverse 
3 rie 1! bit § - blink — 
3 7 7? bit - underline 
; 718 ; Oe bit 4 = bell 
: 719 § .? bit 5 = conversion. 
; 720 1; bit § - decimal point is comma 
s fel bit - to allow space for sign in PROTECTED 
: 7 $ 2: reo z ACCEPT, 1 no allowance for sign 
: FF 2 1! bit 8 =- protect 


TT 


poo ee 


3 
¢ CCEPT COBSACCEPT = VAX COBOL ACCEPT Statement besep-1 1986 33:38 +33 AX-11 Bliss-32 V4.0-74 § Page 17 
1-018 COBSACC_SCR = ACCEPT with screen enhancements 1a-Sep- 19 COBRTL.SRCIC coaace EPT.832;2 (4) 
iB er BIE faz BSS ings 1 ne agvancin 
- anc no advanc 

7 5 bit 11 - § for VAX Peeou" 1for VAX RPG 

; 4 : DEFAULT. rt.dx Petauts source moved to destination descriptor 

7 ? (STRING DEST) in the event of null input. 

; 1 44 : SIZE.rlu.v Size of protected field. Only applicable if the 

f ¢ $2 } protected flag is set. 

4 ¢ - : KEY.wt.ds Destination of the receiving field of the control key 

‘3 : LENGTH. wlu.r Destination of the number of characters read 

, 8 ; IMPLICIT INPUTS: 

my 38 Status of whether the input file is currently open. 

7% 55 i IMPLICIT OUTPUTS: 

7% 28 : 

744 5 : Updated status of file 

745 58 : 

ms 59 ! ROUTINE VALUE: 

74 ' 

748 : If .UNITC1) is false : specified. 

749 ; If .UNIT(C1] is true : er true or false, indicating success or 

750 } for respectively. 

r SIDE EFFECTS: 

754 Reads a record from a designated uint. 

' 
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2 
755 : 
3 
38 BEGIN 
ree LOCAL 

‘¢ 

% ‘ : Note; other declarations are in the macro S$BIND_PARAMETERS. 
764 $ RAB REF SRAB_DECL, 
765 2 PUT_SIZE WORD, ' ACC_SIZE plus 5 (for escape 
766 2 ' sequences 
767 § ON_BUF : VECTOR C20, BYTE), ' Holds escape seq te turn on 
768 ' terminal attribut 
769 S¢ ON_LEN INITIAL (0), : Length of ON_BUF 
770 FURC_VAL_2, ' Q10 Function Modifiers used 
771 ! in the item List for RMS $GET 
77. 5 PROT -pK : INITIAL (0), ' = 1 if no Protection errors 
77 a6 CONV” OK : INITIAL (0), ! = 1 if no Conversion errors 
774 8 REPROMPT_DONE : INITIAL (0), ! = 1 if reprompt performed in 
775 88 ' response to a Conversion error 
77 34 YES_CONV INITIAL {0}. ! = 1 if Conversion requested 
77 YES"NO_ECHO INITIAL (0), ' = 1 if No-Echo requested 
778 91 YES- SIGN INITIAL (1), ! = 1 if no allowance for sign 
779 § : gi ‘ys n. wore - initialized to 1 
780 229 P_DATA_TYPE : INITIAL (0), : or 99PP data types 
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EROES, ! 2x0" filler 
LANKS ' 2c* * filler 
PARAME TERS : VECTOR (22) i Buffer to hold data to be 
INITIAL (REP 22 OF (0)) ; ! passed to subroutines 
BUILTIN 
NULLPARAMETER ; 
LITERAL 
PROT_SIZE ’ ' # of chars allowed for input 


SSaroncesase 


AAAI AAA AI AIA 
IA. AAP POPPIN PONIES OO OO OO 
MEUM $0 OONOUEWN —OOOVNOUS WO 0@ 
* 


woe) 


ER ratia lat iatlatiatlat ia La TAT LATTA LATAA LATTA LAT IATA IA AAT IATAATAATAATIATAAT IA AAT AAT AAT AAT cat cat Latah abt aataataataataataatcat) 
WAAL ALAA AAA 
RWW 


SESERE 
SCODONOUESWN—O0® 


BH FAW NIPPINIPIPUPINPININININYNINININININY 


RoPonofonofonopofopfofory 
ww 
ws 


D_PROT_SIZE = 22 ; 
Bind PARAMETERS to other names. 
SBIND_PARAMETERS ; 


! when PROTECTED is requested 
! for floating and double fl. 


Fillers = used by STRSDUPL_CHAR, therefore they cannot be Literals 


ZEROES = 2x'O" ; 
BLANKS = %C" ° ; 


Put ACCEPTed data from RMS $GET in this buffer. 


PUT_HERE [DSC$W_LENGTH)] = 0 ; 

PUT-HERE [DSCSB_DTYPE] = DSCSK_DTYPE_NL ; 
PUT"HERE CDSC$B-CLASS] _ = DSCSK~CLASS-D ; 
PUT“HERE CDSCSA-POINTER) = 0 ; 


Determine if PROTECTION has been requested. 
If sc, set the size of the field oy either the value of the SIZE parameter 
or the length field of the STRING_DEST descriptor. 
if no PROT CTION requested, use COBSK_ACC_SIZE (1024 - same as 

ccept). 
Also make adjustments if both PROTECTION and CONVERSION are requested - 
add room for sig" and a decimal point, in some cases look at DSCS$B_DIGITS 
instead of DSCSW_LENGTH 


*P* data ty es need special handling. 
STRSGE 


Use _DX to allocate space for dynamic string PUT_HERE. 
If ( .FLAGS AND V_CONV ) NEQ 0 THEN YES CONV = 1 ; ! Avoid BLISS 
IF ( .FLAGS AND V-NO_SIGN ) NEQ 0 THEN YES_SIGN= 0; ! optimization problems 
If ( .FLAGS AND V_PROTECT ) NEQ 0 
THEN 


BEGIN ! Begin Protect Size 
YES_PROTECT = 1 ; 
IF .SIZE NEQ 0 
ate ACC_SIZE = .SIZE ! Use SIZE 
BEGIN ! Begin no SIZE param 
LOCAL ES 
pp99 : initial (0) ; ' Scale for PP99 data 


' type 
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H 4 
; 4 99 = .string dest [dsc$b_ digits] + ,string dest Cdsc$b_scale] ; 
; B40 : AEC_SIZé = .STRING. DEST CDSCSO.LENGTHS ; "7 Use STRINGZDEST 
: 86 4 '¢ 
3 Be 4 ! Special case 'P’’ data types (each ‘'P’' specifies an assumed scaling position). 
; 846 4 ! NOTE: ALL code pertaining to the ‘P"’ data type is in lowercase. nce *'P*’ 
+ 845 4 ! data types are such an off the wall issue, leaving this code in lowercase is 
: ate 2 the best way to avoid ‘P’’ code interfering with ‘‘normal’’ data types. 
; B48 § ; if ((.string_dest Cdecte close. eql dsc$k_class_sd ) 
; Sep and ((.pp99 Lss_0) ! P’ Picture of PP99 
; Bey ? me or (.string_dest(dsc$b_scale] gtr 0))) ! P Picture of 99PP. 
; en 
3 $36 yt . ' ! begin P data types 
; a es : 
3 See 367 iY "pp99 iss 0 ! P Picture of PP99 
; en 
3 $28 4 5 acc_size = abs (.string_dest(dsc$b_scale]) 
; © 
; o28 a 2 acc_size = .pp99 ; 
; 860 38 3 if .yes_conv 
; 861 374 5 then 
3 4, 375 6 begin 
; +486 3/8 6 '¢ 
; +e) a4 ? Allow space for a decimal point for PP99 but not 99pp. 
ODS ipo ts 
; en 
; aes $65 ? acc_size = .acc_size + 1 ; ! decimal point for pp99 
; 870 2388 é \4 ; ; 
; «871 384 6 ! Because we are reading the digits and scale fields. 
; 87 tH 6 ! all numeric data types will need an extra space for 
; 1h, $59 ? :_ the sign - except Numeric Unsigned. 
: 875 388 6 
3 a76 $05 ? if «string_dest Cdsc$b_dtype] neq dsc$k_dtype_nu 
; en 
3 378 $95 ? acc_size = .acc_size + 1 ; 
; 880 395 6 i Additional check for VAX_11 COBOL COMP and COMP3 
; 881 toe 6 ! data types - if YES_SIGN = 0 then do not include 
: HH 392 ? space for sign. 
; 884 397 8 if (((.string_ dest Cdsc$b_dtype] eql dsc$k_dtype_w ) or 
; 885 395 (.string_ dest [dsc$b_dtype] eql dsc$k_dtype_wu ) or 
; 886 99 (.string_ dest [dsc$b_dtype] eql dsc$k_dtype_l ) or 
; 887 400 (.string_ dest Ldsc$b_dtype] eql dsc$k_dtype_lu ) or 
; 888 401 (.string_ dest Ldsc$b_dtype] eql dsc$k_dtype_q ) or 
; 889 rt (.string_ dest [dsc$b_dtype] eql dsc$k_dtype_qu ) or 
: 890 40 (.string_dest [dsc$b_dtype] eql dsc$k_dtype_p )) 
: $93 rt an and .yes_sign eql 0 ) 
: $98 006 g acc_size = .acc_size - 1 ; 
; 894 40 end ; 
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; 4 end : end P data types 
2 
; 89 410 4 else 

; 898 411 4 '¢ 

: 34 tig 4 ' Non P data type 

: 901 tie § begi ; 8 rae 

5 egin egin non ata type 
: 902 415 IF). YES_ CONV i adjust ACC_SIZE. 

:; 90 ret THEN 

> 904 41 '¢ 

; 905 418 ! Make room for overpunch sign. 

; pas 419 ! Packed data type - check to see if sign should be 

; 90 420 ! included. 

; 908 421 te 

; 909 4 ; § BEGIN 

; 910 & IF (C(.STRING_DEST COSCSB_DTYPE] EQL DSCSK_DTYPE_NRO ; OR 

; 911 424 7 (.STRING_DEST COSC$B_DTYPE] EQL DSCSK-DIVPES Be! OR 

3 aig 425 8 (.STRING_DEST CDOSCSB_DTYPE] EQL DSCSK"DTY AND 

; 91 es$ 7 yes SIGN. 

; 916 427 6 THEN 

: 915 428 6 ACC_SIZE = .ACC_SIZE + 1 ; 

: 916 429 6 

; 917 430 6 ¢ 

; 918 431 6 ! COMP = Look at digits field plus one for sign, only if 

:; 919 $38 6 ' conversion is requested. 

; 920 433 6 ' VAX_COBOL always sends an SD descriptor for W, L, @ when 
: 921 434 6 ' Conversion is used. 

3 356 435 6 i Check to see if sign should be included. 

; & 436 6 ie 

; ose 437 6 

; : ; rt : IF " -STRING_DEST CDSCSB_CLASS] EQL DSCSK_CLASS_SD ) 

; 359 2440 8 ccc. HA feo Sa $2 DSCSB_DTYPE] EQL DSCSK_DTYPE_W ) OR 
: 928 441 8 (STRI NG_DEST COSCS$B_DTYPE] EQL DSCSK_DTYPE_WU ) OR 
; 99 44 8 (.STRING-DEST CDSCSB_DTYPE) EQL DSCSK-DTYPE_L ) OR 
: 9 244 (.STRING_DEST COSC$B-DTYPE] EQL DSCSK-DTYPE-LU ) OR 
; 931 2444 8 (.STRING_DEST COSCSB_DTYPE) EQL DSCSK_DTYPE_Q ) OR 
g 336 445 ° (.STRING_DEST COSCSB_DTYPEJ EQL DSC$K- ot “au )) 

: 93 446 AND .YES_SIGN 

; 934 447 6 HEN 

; 935 448 6 ACC_SIZE = .STRING_DEST CDSCS$B_DIGITS] + 1 ; 

; 936 449 6 

: 937 450 6 + 

; 938 451 6 i Floating pt - 13 for Floating, 22 for Double Floating. 

: 939 $26 6 in 

: 940 453 6 

3 «941 454 7 IF (.STRING_DEST COSCSB_DTYPE] EQL DSCSK_DTYPE_F ) 

: 9 455 6 THEN 

; 94 456 $ ACC_SIZE = F_PROT SIZE ; 

; 966 eet IF (.STRING_DEST-CDSCSB_DTYPE) EQL DSC$K_DTYPE_D ) 

3 4 459 6 ACC_SIZE = D_PROT_SIZE ; 

; 94 460 6 

: 948 461 6 te : : 

3: 949 re § 6 ' Make room for decimal point 

; 950 4635 6 '- 

; 951 464 6 
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, 9 ¢ 465 7 IF (.STRING_DEST COSCSB_CLASS] EQL DSCSK_CLASS_SD ) 

li; 9 466 6 THEN 

s 9 rhe g ACC_SIZE = .ACC_SIZE + 1; 

: 38 rhc hen ' End non Pd 

3 end ; ' End non ata type 
: Be 479 END : i End no SIZE param 
$ 328 ris ase’ ! End Protect Size 
; 960 or ACC_SIZE = COBSK_ACC_SIZE = RMS_HEADER ; ' 10246 - 4 is s 

3 +d rh = ' Limit as a DISPLAY 
3 368 47 ! Allocate enough room in PUT_HERE to we fo the terminator escape sequences. 
; 9646 47 ! Most sequences are 4 bytes Or less. (PUT_SIZE is 5 more than ACC_SIZE.) 
; 965 47 Note: PUT_SIZE used, not ACC_SIZE. 

; + ¢ 47 t- 

; 96 480 

: 968 481 PUT_SIZE = .ACC $33 . 

: 969 48 TF TACC_SIZE LSS 920 THEN PUT_SIZE = .ACC_SIZE + 5 ; 

; 971 84 IF NOT ( STRSGET1_DxX ( &REF (. PUT. SIZE ), PUT_HERE )) 

; 97 485 THEN LIBSSTOP ( COBS_ERRDURACC ) 

ee 486 

: 9746 487 te 

; 975 488 ' Check first oyte of UNIT param. 

: 976 489 ! If this file is not open, open it. (Note: only first exte of UNIT is 

3; 977 490 sent to COBSSOPEN_IN) 

; 978 491 t= 

; 979 49 

3 980 493 IF .UNITCO] GTRU COBSK_UNIT_MAX 

s 1 495 LIBSSTOP ( COBS_INVARG ) ; 

> 984 497 IF .COBSS$AL_WRITE_RAB C .UNITCO] ) EQL 0 

; «985 498 THEN 

; 986 499 '¢ 

: 987 500 ' Second porenstor tells COBSSOPEN_IN whether VAX COBOL (0) 

: 988 501 ' or VAX RPG (1) is the caller. 

; 989 208 Hod 

; 990 50 COBSSOPEN_ IN ( .UNITCO], 

; 991 504 IF ¢ FLAGS AND V_COB_RPG ) NEQ 0 

3 238 505 THEN 7 

; 99 506 ELSE 0) ; 

: 994 507 

; «4995 208 RAB = .COBSSAL_WRITE_RAB C .UNITCO] ] ; 

; 996 5 

; 997 510 '¢ ; : , : 

; 998 511 ! Find out if the device is a terminal. 

; 999 218 '- 

3; 1000 51 

: 1001 514 BEGIN 

: Hs 515 LOCAL 

: 100 218 STATUS 

; 1006 2 NAM_DSC : REF BLOCK (8,BYTE) ; 

: 1008 31 NAM_DSC = .RAB + RABSC_BLN ; 

; 100 259 

: 1008 521 If .COBSACC_TERM_TYPE EQL 0 


ee 
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3 THEN 
1 : IF NOT ( COBSSSETUP_TERM_TYPE ( .NAM_DSC PoSesA_Poruteny. 
1 4 -NAM_DSC LOSCSW_ LENGTH], 
1 5 COBSACC_TERM_TYPE ) ) 
Ol $ THEN LIBSSTOP ( COBS_ERRDURACC ) ; 
15 3 IF .COBSACC_TERM_TYPE EQL UNKNOWN 
2 | 2 Ps THEN 
$18 531 i If terminal is UNKNOWN then it can be assumed we are working 
019 5 ¢ ! with files rather than terminals. Pull out of this routine 
020 é ' and go to COBSSACC_SCR FILE which uses a slightly different 
8 1 2 ; variation of the RAS $GET Service. 
0 ‘ 5 $ BEGIN 
024 5 STATUS = COBSSACC_SCR_FILE ( .UNIT, .STRING_DEST, .FLAGS, .DEFAULT, 
025 538 .LENGTH, .ACC_SIZE, PUT_HERE, .YES.CONV, 
° 228 - -YES_PROTECT, .YES_SIGN ) ; 
028 241 ! Free local string PUT_HERE 
080 278 if NOT ( STRSFREE1_DX ( PUT_HERE )) 
O33 a¢e THEN LIBSSTOP ( COBS_ERRDURACC »3 
038 323 A ee STATUS) 
035 548 RETURN 0 
036 54 
037 55 RETURN 1 ; 
039 33 
55 
55 
55 
55 
55 
55 
55 
56 
56 
56 
6 


. 
a 
- 
* 
. 
° 
° 
. 
e 
7 
o 
a 
° 
© 
a 
. 
° 
. 
o 
. 
a 
. 
° 
. 
° 
o 
a 
2 
oO 
- 
*. 
. 
@ 
7 
6 
- 
° 
. 
* 
- 
*. 
+ 
° 
> 
° 
. 
° 
° 
© 
° 
. 
° 
. 
. 
. 
o 
© 
° 
- 
° 
. 
° 
. 
- 
- 
° 
. 
° 
* 
° 
. 
° 
7 
o 
o 
° 
» 
° 
° 
7 
e 
. 
e 
. 
° 
. 
° 
. 
° 
° 
° 
7 
° 
° 
e 
. 
° 
° 
> 
° 
° 
° 
. 
2 
. 
° 
. 
oa 


C 

4 

4 

4 

4 

4 

4 

4 

4 

4 

5 

4 

4 

5 

4 

4 

4 L 
4 

; EN 
END ; 
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8 
9 
0 
1 
39 ¢ 
040 
041 4 
ok 5 '¢ 
04 § ! Flag to COBSACCEPT that COBSACC_SCR has been called. COBSACCEPT will 
044 ! have to perform a Carriage Return. 
045 8 !- 
046 9 
047 0 ACC_SCR = 1; 
048 1 
049 ; BEGIN ! Begin $GET 
050 5 
051 564 '¢ 
036 565 ! VAX COBOL Version 1 / Version 3 Interaction. 
05 268 ! Advancing philosophy : <LF> $GET <CR> 
054 56 ! <LF> based on previous call. 
055 568 ! <CR> based on current ACCEPT using FLAGS bit 10. / 
056 28? ! If previous call requires advancing then perform a Linefeed. DISPLAY (DISP) 
057 570 ! and ACCEPT (ACC_ADV) with edvanc ing, POS = call to module COBSPOS_ERASE 
058 571 ! remembers what previous call was, if advancing then POS, if no advancing 
059 276 ! then POS_DNA 
060 57 !- 
061 574 
0o¢ 575 4 IF (.COBS$AB_PREVLO) EQL DISP 
06 276 4 OR .COBSSAB_PREV § EQL POS 
064 577 4 OR .COBSSAB_PREV EQL ACC_ADV ) 
065 578 3 THEN 
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‘+ 
Echo Linefeed to terminal 


COBSSRMS_PUT_BYTE ( LINE_FD, .FLAGS ) ; 


SSSs2 


OONOVS WOOD 


! Did user request any terminal attributes (bold, blink, underline, reverse) ? 


C 
¢ 
3 3 
3 3 
3 3 
5 3 
3 10 
oi 
; 107 5 ! If so, call COBSSSET_ATTRIBUTES_ONLY to get escape sequence to turn 
; 107 3 i attributes on and off. 
3 ft 2 PUT_FLAG - first four bits (0-3) of FLAGS parameter. 
; 197 239 
3 Ig? 44! PUT_FLAG = .FLAGS AND FLAG_MASK ; 
; 1080 298 IF .PUT_FLAG NEQ 0 
3; 1081 594 TH 
3; 108 595 4 IF NOT ( COBSSSET_ATTRIBUTES_ONLY ( .COBSACC_TERM_TYPE, .PUT_FLAG, 
; 108 238 4 ON. BUF Co} OR_LEN 
3 1084 597 4 OFF_BuF CO, OFF_LEN ) ) 
: 1085 598 THEN LIBSSTOP ( COBS_ERRDURACC ) ; 
>; 1086 599 
3; 1087 600 '¢ 
3 H+4 et If requested, add sequence to ON_BUF to ring terminal bell. 
3; 1090 60 
3 1091 604 IF ( .FLAGS AND V_BELL ) NEQ 0 
; 1098 605 THEN 
; 109 one 4 EGIN 
3: 1094 607 4 ON_BUF C .ON_LEN J = BELL ; 
3 1095 608 4 ON_LEN = .ON_LEN + 1 ; 
: 1096 609 END ; 
3; 1097 610 
3; 1098 sol) '¢ 
3; 1099 oi¢ ! Check parameters to see if the CONTROL KEY FORMAT 4 ACCEPT has been 
; 1100 61 ! requested. If so, pull out of this routine and call COBSSFORMAT_FOUR 
3; 1101 614 ! which uses a different Terminator Mask and does not need all the 
; 1308 615 ! enhancements in COBSACC_SCR. 
3; 110 616 fe 
3 11046 617 
3; 1105 618 IF NOT NULLPARAMETER (KEY) 
; 1106 619 THEN 
3; 110 620 4 BEGIN 
3; 1108 621 4 LOCAL 
3 1109 6 § 4 KEY_LEN ; 
3 1110 6 4 
37111 624 & KEY_LEN = .KEY CDOSCS$W_LENGTH) ; 
3 ie 625 4 STRSDUPL_CHAR ( .KEY, KEY_LEN, BLANKS ) ; 
31711 6 $ 4 
3 11146 6 4 '¢ : ‘ 
3 1115 6 3 & ! If these poreneters are not present then we are dealing with 
3 1338 6 & ' a Format Four ACCEPT rather than a Format Three ACCEPT. 
3111 630 4 fe 
3; 1118 631 4 
3 1119 6 § IF (NULLPARAMETER (LENGTH) AND 
: 1120 6 NULLPARAMETER (SIZE) A 
3 1121 Ose NULLPARAMETER (DEFAULT) AN 
3: 1122 635 NULLPARAMETER (STRING_DEST) ) 


ee oe 
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: 1123 6 4 
: 1126 6 5 IF NOT ( COBSSFORMAT_FOUR ( .UNIT, .FLAGS, .KEY )) 
; 1125 6 : 6 THEN RETURN 
311 $ 6 & ELSE RETURN 1 ; 
3 11 640 3 
We Bod. 
; 1150 64 ! Determine FUNC_VAL = Q10 Function Modifiers used by RMS S$GET Service. 
3 1131 644 ! Check FLAGS parameter to see if NO-ECHO was requested (bit 9), if so 
311 é 645 ! set TRMSM_TM_NOECHO to suppress echoing of input characters to the terminal. 
3 41 o*8 ! Set TRMSM_TM_ESCAPE to allow Escape Sequences to act as terminators (Arrow 
311 64 ! keys PF Keys. and the Professional editing and top row function key Ps 
3: 1135 645 ! Se fRMSM_T -NOFILTR to have the DELETE KEY handled by COBSSDELETE_KEY. 
3 11 649 ! Set TRMSM_TM TRMNOECHO to suppress echoing of the termination character 
311 650 ! (COBSSAB_PREV handles advancing / no advancing). 
: 113 eso 3 
: 1140 $38 If ( .FLAGS AND V_NO_ECHO ) NEQ 0 
3 1141 654 THEN 
3 ite8 655 4 BEGIN 
3 114 656 4 FUNC_VAL = TRMSM_TM_ESCAPE + TRMSM_TM_NOFILTR + TRMSM_TM_TRMNOECHO 
3 1146 657 & + TRMSM_TM_NOECHO ; 
3 1145 658 4 YES_NO_ECHO = 1 ; 
3 1146 659 4 END 
3 1147 660 ELSE 
3 1108 e6 FUNC_VAL = TRMSM_TM_ESCAPE + TRMSM_TM_NOFILTR + TRMSM_TM_TRMNOECHO ; 
: 1150 66 rr 
3 1151 664 ! Main Loop of routine. 
3 1128 $oe2 ! PROT_OK = 1 => there was no Protection error *' eS 
3; 115 666 ! CONV_OK = 1 => there was no Conversion error ‘‘equal'’ SUCCESS => pull out 
3 1154 2667 ! of loop. Otherwise continue accepting data until there are no errors. 
3 1155 $068 ! If error, reprompt user for more input via macro SERROR_REPROMPT. 
ee 
; 1158 oer WHILE (.PROT_OK EQL 0) OR (.CONV_OK EQL 0) DO ; 
3 1159 $078 4 BEGIN ! Begin loop 
3; 1160 6735 4 LOCAL 
3 113) 3675 ? TERM_SEEN =: INITIAL (0) ; ! Flag for PROTECT check 
; 1183 676 4 IF .REPROMPT_DONE EQL 0 
3: 1164 677 & THE : 
; ! Begin no repromp 

Hy 3 O78 BEGIN ! 8B t 
i 116? 680 1+ 
: 1168 681 5 ! If PROTECTION requested, put a Protected Field on the screen. 
3 4 ose 5 ' $PUT ACC_SIZE blanks to screen with attributes requested 
3; 1170 6 5 ' by user turned on. (Escape sequences geared to VT100 
31171 6 !' terminals) Can only sgt a one Line field as a max, therefore 
3 1178 685 FIELD_BUF holds up to 300 characters. 
3 1174 6 
3 1175 688 IF .COBSACC_TERM_TYPE EQL vT100 
3 1328 689 5 THEN ‘ 
3 117 690 6 BEGIN ! Begin VT100 
3: 1178 691 6 IF .YES_PROTECT 
3; 1179 692 6 THEN 


| 
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Me REY edt bem 
: 11 ; 695 7 FIELD_BUF VECTOR (300, BYTE), 
; i 238 7 FIELD_LEN ; ! size of FIELD_BUF 
: 1185 698 - '+ 
3 11 4 7 ! Buffer FIELD_BUF to write Protected Field contains 
3: 1187 00 7 ‘ = escape sequence to turn attributes on, 
3; 1188 701 7 ! - number of blanks to write to screen and 
3; 1189 7 ¢ 7 ! - backspaces (same # as blanks) to put cursor 
; 8 + 4 4 back to original position. 
; 1198 705 7 
3 119 706 7 CHSMOVE ( .ON_LEN, ON_BUF [OJ], FIELD BUF C0] ) ; 
3 1194 707 7 FIELD _LEN = .ON_LEN ; 
: 1195 708 7 CHSFICL ( BLANK, .ACC_SIZE, FIELD BUF C.FIELD_LENJ ) ; 
: 1196 709 7 FIELD LEN = .FIELD_LEN + . : 
; 119 710 7 CHSFICL ( BS, .ACC“SIZE, FIELB BUF E.FIELD_LEN] ) ; 
: Bb ap f FIELD_LEN = .FIELD_LEN + .ACC_SIZE ; 
; 1200 ab 7 14 
: 1201 714 7 ! If size of FIELD_BUF is greater than the size of the 
: 1906 2715 7 ' maximum allowed for a $PUT buffer, issue an error 
; 120 716 7 ! message. Issuing multiple S$PUTs at this point does 
3: 1204 717 7 ! not help as the cursor is unable to get back to the 
3 \¢0? srg 4 } starting position and ends up in the wrong Line. 
; 1509 720 7 ec 
5 +4 ts! ° A oF BEAR LEM GTR (COBSK_ACC_SIZE = RMS_HEADER) ! 1024 -14 
: 1310 a138 , LIBSSTOP ( COBS_ERRDURACC ) ; 
: 121 725 7 1+ ; 
3 \Slz 768 g $PUT to write Protected Field to terminal 
> 1215 728 7 
: isi¢ 44 4 COBSSRMS_PUT_BUFFER ( FIELD_BUF COJ, .FIELD_LEN, .FLAGS ) ; 
: 1218 731 6 END ; ' End Field 
3 1219 rag 5 END ; ! End vT100 
3; 1220 733 «5 
3 iss! 734 5 !eeeee 
: 12 § 735 5 !eeeee RMS S$GET Service 
: \§ 7 lenene 
a 34 ; 
3 \ 5 738 '¢ 
3 1226 739 «5 ' RMS $PUT to turn on terminal attributes (blink,bold,underline, reverse). 
: 1227 740 i RMS $GET to accept input. Do not perform the $PUT if PROTECTED 
: : ; Sh is requested as the FIELD_BUF SPUT has already turned attributes 
r ! on. 
3 7 74 ! Note :  TRMS_PROMPT not used because of buffer size Limitations. 
3 1231 744 ‘ TRM$_MODIFTERS uses all of specified buffer for accepting input, 
3; y ¢ 745 : TRMS$_PROMPT uses same buffer for both the prompt string and the 
3 : % ef } accepted data, therefore some space for accepting data is lost. 
: 1235 748 : 
3 1335 749 IF .ON_LEN NEQ 0 AND .YES_PROTECT NEQ 1 ! If requested, turn 
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: 1237 750 THEN ' attributes on 
; 1238 751 COBSSRMS_PUT_BUFFER ( ON_BUF [0], .ON LEN, «FLAGS ) ; 
Be eg . 
: : 2) f 2 } RMS $GET to accept input from terminal. 
: 124 r 
3: 12446 7 $ RAB = .COBSSAL_WRITE_RAB C .UNITCO] J 
3 1245 738 COBSSRMS_GET (~.RAB,~.FUNC_VAL, .ACC “size, 
: : r 64  PUT_HERE CDSCSA_POINTER] ) ; 
3 1248 761 5 END ! End of no reprompt 
: 1249 166 4 ELSE 
3; 1250 7635 4 REPROMPT_DONE = 0 ; ! re-set flag 
: 1251 764 4 
3 3 2g 765 4 + 
3; 125 766 4 ! Get number of characters read and terminator size from the fields 
> 1254 767 4 ! of the RAB. Pass this info along to other routines. 
3; 1255 768 4 ' RAB field 
3 1256 769 4 ! rab rab$l usts = status 
3; 1257 2770 & ! rab Crab$l"rsz = x no. of chars read 
: 1628 gril 4 ' rab Ccob$$B_stv0_term] = d <cr> terminator seen 
3; 1259 772 & ' rab Ccob$$b_stv2_len] = 1 size of terminator 
3; 1260 2773 4 ' Save this information” oe lle COBSSPARTIAL SEQ does any more S$GETs. 
3: 1261 2774 & le 
: 1668 2775 4 
: 126 2776 & CHARS_READ = .RAB CRAB$W_RSZ) ' Number of chars read 
> 1264 e777 TERM_SIZE = .RAB CCOBSSE "STV, LEN] ; ! Size and Location of 
> 1265 2778 & TERM_LOC = RAB COBS$B_STVO_TERM] ; ' terminator - other 
3 1266 si 4 ' routines may update 
3 1267 780 4 ' these 
3: 1268 2781 4 '+ 
3: 1269 ree 4 ! Check for partial oe gene he = not enough room in input buffer 
3 16% 783 4 ' to hold entire orrepe 3 couse hen a Protected ACCEPT is performed. 
; 167) ree 2 ! If necessary, call COBS$ ARTIAL” SEQ to read remainder of sequence. 
; 1398 2786 4 
3; 1274 sree 4 IF .RAB CRABSL_STS) EQL RMSS$_PES 
g if 14 788 4 THEN 
3: 1276 siep 5 N 
3 1277 790 5 TERM_SEEN = 1 ; {lag here as 
3; 1278 791 «#5 COBSSPARTIAL_SEQ ( PARAMETERS, .UNIT ) ; i sbessPe TIAL_SEQ may 
3 if 4 a : END ; i change status value 
i 158i 794 4 \4 
3 1e8¢ 795 4 ! If terminator was the DELETE KEY call COBSSDELETE_KEY. 
: 1584 es Pe 
3 \s02 oe ? IF .RAB CCOBS$B_STVO_TERM] EQL DEL_KEY 
3 14 on0 ? COBSSDELETE_KEY ( PARAMETERS, .UNIT, .FLAGS ) ; 
: 1589 80 4 !eeeeeee 
: 1290 03 4 !eeeeree PROTECTED 
3: 1291 804 & !eeneere 
5 Y 4 805 4 
3; 129 806 4 '¢ 
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on 


Was terminator seen on PROTECTED READ? 


Looking for terminator to make sure that user hasn't tried to go 
beyond the bounds of a PROTECTED READ. 


Two ways for a protected read to complete - 


ARAL OOOO 


C 
C 
3; 3 eo? 4 : 
5} 08 4 ; 
3; 1 Hs 4 ' 
3 Y 10 4 : 
3 1 11 4 : 
3; 3 \ 4 : 
3 7 13 4 : 1. terminator “es before buffer filled ( no further check necessary) 
3 3 B14 4 : 2. buffer fill ( no terminator seen) 
3 1 815 4 : - do a one character read to make sure terminator is 
3 ; 318 : } typed, not another character. 
.-= 518 & ! The following RAB fields look like this if buffer filled 
; 1306 19 4 : rab rabst sts) = status ’ 
; 1307 as & ; rab Lrab$l_rsz = x no. of chars read (acc_size) 
: 1308 821 4 ' rab Ccob$$B_stvO_term] = 0 no terminator seen 
3 1309 Bs¢ 4 : rab Ccob$$b_stv2_len] = 0 size of terminator 
: 1310 8 4 mm 
3; 1311 sBse 4 
; 1g 825 5 IF (.YES_PROTECT ) ! Was PROTECTION requested? 
; 1312 sase 2 on AND ( .CHARS_READ NEQ 0 ) ! AND is it needed 
; 1318 2828 4 IF .RAB CRABSL_STS] EQL RMSS$_TNS ! RMS$_TNS = Terminator 
: 1316 soe? 4 AND [TERM_SEEN EQL 0 ! Not Seen 
3 1317 2830 4 THEN 
3; 1318 tt 5 BEGIN ! Begin protect check $GET 
3 1319 aag 5 '¢ 
; 1320 see 5 ! After initial S$GET is performed it is necessary to perform a 
3 1321 834 5 ! $GET of Length 1 to make sure that there are no characters 
3 1386 2835 5 : typed by the user that exceed the maximum allowed. 
3 132 2836 5 ! (Do not echo character to terminal.) . 
3: 1324 2837 5 ! If the SGET of one character results in a terminator, there 
3 1325 2838 5 ! is no problem. é 
3; 1326 2839 5 ! If the SGET of one character results in an attempt to type 
; 1350 seee 2 } extra characters, there is an error. 
3; 1329 sere 5 ! If VAX RPG is the caller, always return control to the 
3: 1330 28435 5 ! calling program on an error. 
3 133! 2844 5 te 
3 1 3 2845 5 
3; 133 2846 5 f 
3 1334 of! 5 NO_CHAR : INITIAL (0), ! =1 no Protection error 
: 1333 ane 2 HAVE_TERM : INITIAL (0) ; ! =1 terminator seen 
3 RL 3850 5 WHILE .HAVE_TERM NEQ 1 DO 
3; 1338 851 6 BEGIN ! Begin HAVE_TERM loop 
: 1339 $26 6 
3 1340 8535 6 NO_CHAR = 0 ; 
3 1341 854 6 FUNC_VAL_2 = TRMSM_TM_ESCAPE + TRMSM_TM_NOFILTR 
; 1348 899 6 +"TRMSM_TM_TRMNOECHO + TRMSM_TM_NOECHO ; 
3 1344 Ha 6 RAB = .COBSSAL_WRITE_RAB C .UNITCO) J ; 
3 1345 858 6 COBSSRMS_GET (~.RAB,~.FUNC_VAL_2, 1, NEXT_CHAR ) ; 
3 1366 859 6 
3 134 860 6 '¢ ; 
3 1348 861 6 ! If user did not attempt to enter more data, set TERM SIZE 
> 1349 86¢ 6 i and TERM_IN_NEXT before possible call to COBSS$PARTIAC SEQ. 
; 1350 2865 6 ! If not enough room in $GET buffer to hold entire escape 
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3: 1351 4 6 ! sequence then call COBSSPARTIAL_SEQ to read remainder 
. 7 He 6 : of pequence. 
3 1 r¢ 6 !~ 
3 1354 67 6 
; 1355 68 6 IF .RAB CRABSW_RSZ) EQL 0 ! No more data entered. 
S| 28 M4 § THEN 
; 135 0 BEGIN 
: 1358 871 7 NO_CHAR = ove terminator into 
; 59 Bre f NEXT _CHAR loi = .RAB CCOBSSB_ sTVv0: TERMS ! NEXT_CHAR 
: 1361 874 6 TERM_ SIZE = .RAB CCOBS$B -STV2_LEN]_; ! Terminator size. 
3: 1 § 18 6 TERM_LOC = » RAB COBS$$B_STVO_ TERM]: | Terminator Location. 
, 76 6 TERM_ IN_NEXT i Terminator on NEXT_CHAR 
: 1 877 6 IF .RAB™CRABSL _st83 EQL RMS$_PES 
3: 1365 878 6 THEN 
es 879 6 COBSSPARTIAL_SEQ ( PARAMETERS, .UNIT ) ; 
3: 1367 880 6 
3; 1368 881 6 '¢ 
3; 1369 2882 6 ! Terminators are the only acceptable input at this point. 
3; 1370 2885 6 ! If NO_CHAR = 1 then there is no Protection error. 
ne : 
3 1378 2886 6 IF .NO_CHAR 
3 1374 887 6 THEN 
3; 1375 888 7 ! Begin TERM accepted 
3; 1376 889 7 PROT_OK eis i $GET successful 
3 137? 2890 7 HAVE_TERM els 
3; 1378 2891 7 
3; 1379 2892 7 !eeenee 
3; 1380 2895 7 leeevee DELETE KEY 
; 1381 894 7 !eeneee 
: 1382 895 7 1+ 
3; 138 2896 7 ! Was termintor the DELETE KEY ? If so, call 
: 1384 897 7 ! COBSSDELETE_KEY to erase the last character 
3; 1385 898 7 ' read and to continue reading for input. 
3 1386 2899 7 te 
3: 1387 2900 7 
3; 1388 2901 7 IF .RAB CCOBS$B_STVO_TERM) EQL DEL_KEY 
: 1389 2902 7 THEN 
3; 1390 $35 : BEGIN 
: 133) aye 4 COBSSDELETE_ KEY ( PARAMETERS, .UNIT, .FLAGS ) ; 
: 1393 $908 i Check to see if we fell out of COBSSDELETE_KEY 
: 139¢ at ! without a valid terminator. If so, keep 
3 1395 908 ! looking for it. 
: 1398 909 8 Hod 
3; 139 910 8 IF .TERM_SIZE EQ. 0 
3; 1398 911 8 THEN 
3; 1399 aig 9 BEGIN ‘ 
3: 1400 913 9 HAVE_TERM = 0 ; ! Loop again 
> 1401 914 9 PROT"OK = 0 ; 
: 1006 915 9 END 
; 140 aig 8 ELSE 
3: 1404 91 BEGI 
3: 1405 4 .] HAVE_TERM = 1 
: 1406 919 9 TERT IN_NEXT = ‘Oo: ' Note = COBSSDELETE_KEY put 
3; 14 ND ; ! the terminator in 
0 920 8 E ! th i 
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ELS 
TERM_PTR = .PUT_HERECDSCSA_POINTER] + .CHARS_READ ; 


3 


'¢ 
! If parameter KEY not sent (.KEY = 0) then CR, TAB, CONTROL 2, 
! and DELETE KEY are the only legal terminators. 
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3; 14 1 ' PUT_HERE. 
: 14 9 END ; “ 
: 1410 9 § 
3; 1411 924 END ! End TERM accepted 
3 1008 925 6 ELSE 
3 161 9 6 
3 1416 9 6 !eeeeeee 
3; 1415 9 6 !eeeeere PROTECTION ERROR 
: 1218 9 6 !eeneene 
: 141 930 6 
: 1018 931 6 '¢ 
3; 141 9 ¢ 6 ! PROTECTION error : 
; 1420 9 6 ! User tried to input too many characters, 
: 1421 9 6 = sound terminal be 
3 ¢ ¢ ; 5 ? } - leave cursor where it is (No reprompt or backspace). 
3 1426 9 § 
3 1425 938 BEGIN 
: 1426 939 7 COBSSRMS_PUT_BYTE ( RING_BELL, .FLAGS ) ; 
3 1427 940 7 PROT_OK = 0 ; ! Signal Protection error 
> 1428 941 7 HAVE-TERM = 6 ; 
: 1429 4 7 END 
3 14 9435 7 
3; 1431 944 5 END ; ! End HAVE_TERM Loop 
; re 945 5 END ! End protect check $GET 
3 14 4 | 4 ELSE 
3 14 94 4 '¢ 
3: 1435 948 4 ! Protection requested but terminator already seen, 
: 1o38 949 ? no need for 1 character Read. 
: 1438 4 PROT_OK = 1 
3 1439 4 ELSE 
3: 1440 4 '¢ 
3 sees ? Protection not requested, no need for 1 character Read. 
; 1208 4 PROT_OK = 1 ; 
: 1464 4 
: 14465 4 !eneeeee 
: rs | 4 !eeeeere CONTROL KEY 
3 144 4 !eeneeer 
3; 1448 4 
: 1449 4 IF .PROT_OK 
3; 1450 4 THEN 
; 1451 4 '¢ : 
3 1636 2 : No sense going thru Control Key code if there was a protection error. 
: 1454 BEGIN ! Begin Control Key 
3 1638 If _ .TERM_IN_NEXT ! Locate terminator, 
3; 145 ! which buffer is it in. 
3 1458 TERM_PTR = NEXT_CHARCO) 
3; 1459 
3; 14 
3; 14 
; 14 
3; 
; 4 
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: 1465 


se 
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If parameter KEY not 0 then CR, TAB, CONTROL 2, DELETE KEY, PF, 
ARROW and SPECIAL FUNCTION PROFESSIONAL Keys are Legal 
terminators. Copy terminator to KEY parameter. 


' 
i 
i 
i 
! 
! Special treatment needed for CONTROL Z under RMS. There is a 
! difference between “Z being typed alone and with data. 

! when “2 is typed with data the “2 is stored in 

! RABCRABS_STVO_TERM], but when “Z is typed alone the status 
RMSS_EOF is returned from the $Get Service. 


IF .TERM_SIZE EQL 1 ! One byte terminator 
THEN 


BEGIN 
TERM_PTR = RAB COBSS$B_$TVvO_TERM] : 
SELECTONE -RAB CCOBS$B~STVO-TERM] OF 


' Carriage Return 
TAB ) : > “dt 


Z These keys are legal, do nothing if KEY = 0. 
= _ NULLPARAMETER (KEY) 
CHSMOVE ( 1, .TERM_PTR, .KEY CDSCSA_POINTER]) ) ; 
Cczjd: ! Control z 


99 

999 
000 
001 
% 
00 

004 
005 
006 


6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
é 
7 
7 
8 
8 
3 
6 
¢ 
6 


'¢ 
i CONTROL Z hit a 
i RAB CCOBSSB_STV 


oo 
oo 
co~y 


jong with data ( terminator in 
O_TERM] ) 


23 
3 


PIPPIN <2 at at et 


BEGIN 
IF (.FLAGS AND V_COB_RPG) NEQ 0 
THEN 
BEGIN 
; VAX RPG = Control Z is an illegal terminator. 


pAb AD AD Ae AS Ae ete eA a ah bh a a a I 


LEGAL = 0 ; 
COBSSILLEGAL_TERM ( PARAMETERS, .UNIT, wt 
END ; 
ELSE 
BEGIN 
VAX COBOL - Control Z has special meaning. 


COBSSCLEAN_UP ( PARAMETERS, .FLAGS ) ; 
COBSSCONTROL_2 ( .UNIT, .KEY) ; 
RETURN 0; 


FUN OC OCONOUE WN Oo 


END ; 
C DEL_KEY ] : ' Delete key 


Be Oe Oe Oe Oe Se Oe Ge Be Se Se Se Se Se Se Se Se Se Ge Ge Ge Ge Oe Se Se Se Ge Ge Ge Se Ge Se Se Ge Se Be Se Ge BH Ge Se Ge Se Se HSH Se Se Ge Ge Ge 4 Se Se Ge SHG 
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BEGIN 
ennai teal ( PARAMETERS, .UNIT, .FLAGS ) ; 


Ooooo 


COTHERWISE) : ! Error = key not a 
! terminator 


GIN 
treat =0; 
COBSSILLEGAL_TERM ( PARAMETERS, .UNIT, ot ty 


YS; 
END ; 
ves 3 
END 
ELSE 

5 Jf CHARS READ EQL 0 AND .RAB CRABSL_STS] EQL RMSS_EOF 
H BEGIN 
2 i CONTROL 2 hit alone - terminator not placed in 
2 RAB CCOBSSB_STVO_TERM], but signaled via RAB CRABSL_STS). 


rs 


A Se aR Se ye ee tt Lat 8 Picture See CESS SSS 
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iF (.FLAGS AND V_COB_RPG) NEQ 0 
THEN 


BEGIN 
LEGAL = 0 ; ! VAX RPG = Control Z | 
Semana abt ( PARAMETERS, .UNIT, .FLAGS, .KEY ) ; 


PWR OO VO Ft OO O08 NOU EURO Doo 
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! VAX COBOL 


Ba Be Oe Oe Oe Oe Oe Oe Oe Se Oe Be 4 Be Oe Oe Be Se GS, Se Ge Ge Se Se Ge Ge SH Oe se Ge Se Ge Oe Se Oe Se FH Se Se Se SH SHS Se Oe Se Oe GH Se Se Oe SH Se oe Se Bee 
ee eee ee ee eee LL LLL LeeLee 
PPA AAAAAR AVIV 
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BEGIN ' 

066 COBSSCLEAN_UP ( PARAMETERS, .FLAGS ) ; 

067 COBSSCONTROL_Z ( .UNIT, .KEY ) ; 

068 RETURN O ; 

069 END ; 

070 END 

071 ELSE 

Ore BEGIN 
5 07 
5 074 '¢ 
5 075 ! Escape Sequence as Terminator. .TERM_SIZE greater 
5 076 ! than 1 and RMS_SEOF not signaled. 
5 077 te 
5 O78 
268 07 IF NOT NULLPARAMETER (KEY) 
56 080 THEN 
568 081 '¢ ; 
569 oes ! COBSSCONTROL_KEY converts terminator sequences to 
570 08 ! COBOL defined sequences and fills in KEY parameter 
3) 084 ! if terminator is legal. 

085 te 

57 0 BEGIN 
574 0 IF NOT ( COBSSCONTROL_KEY (TERM_PTR, .TERM_SIZE, .KEY) ) 
575 4 THEN 
278 0 BEGIN 
57 090 LEGAL = 0 ; H iUlegat escape sequence 
578 091 COBSSILLEGAL_TERM ( PARAMETERS, .UNIT, .FLAGS, 
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END ; 
ELSE 


! Terminator of size greater than 1 is illegal when KEY is 
not used. 


BEGIN 
LEGAL = 0 ; 
se rte tt ( PARAMETERS, .UNIT, FLAGS, .KEY ) ; 


END ; 
END ; ! End Control Key 


ieeeeeee NULL INPUT 


SSLERFAR= 


Ab AL Ab Ab Ab Ab Abd a 
FaREReeS 
2332233228 $3 


SRSSSE 
COoCCoOoO 
NONE WS 2 ODO AONE URI OOO NOU EURO O00 NOME WOOD WR ARO 


“ 


+ 


Null res 

RAB fields look Like this for null input 
rab Crab$l_sts = 
rab Crab$l_rsz 
rab Ccob$$B_stv0_term] 
rab [cob$$b_stv2_len] 


Check for DEFAULT parameter - if psoas: prepare to put it through 
Conversion routines by placing DEFAULT in PUT_HERE. 


status 

no. of chars read 
<cr> terminator seen 
size of terminator 


SoSSSSS sess 


oo 
on 


en -CHARS_READ EQL 0 ) AND (( .FLAGS AND V_COB_RPG ) NEQ 0 ) 
'¢ 
! In case of null input for RPG, simply return (no DEFAULT). 
But perform any necessary clean up first. 
"BEGIN 
COBSSRPG_CLEAN_UP ( .FLAGS ) ; 
RETURN 1 ; 
END ; 
eon -CHARS_READ EQL 0 ) 
By NULLPARAMETER (DEFAULT) AND (.YES_DEFAULT EQL 0) 
BEGIN ! Begin DEFAULT 


CHARS READ = .DEFAULT CDSC$W_LENGTH); 
YES_DEFAULT = 1 ; 


PEPE RAAAAD STA S85 
VEU —“OOSNOUSWN—OO 


POPPIN 2 = 


'¢ 

: Protection check for DEFAULT excluding the Floating 
! Point data ty es ( these will be handled in routine 
COBSSVERIFY_FL_RANGE ). 


Pee Oe Oe Se Se Oe Oe Be Be Se Se Se Ge Fe Se Ge Ge Ge Se Ge Se FH Se Gs SH Se Os Oe SH Os Oe Oe Se Oe OH Se Oe Se Oe Oe Oe oe Oe Se Oe Oe Se Se Se ee SHS Se Sears 
a ak a ee ed ad ad id ed 8“ td = = i 


ee ed ed wd 


BEEBE EE & AWA NWI IWIN NINPIAININININY OO OO 


SOAAOAOAAAO 


Lconenscanaditghaltdcocaltadilbipadensnitcaiccieailiec uaa tiiae tabieieigs Naini tia. oattadeasaddadaedeionaaie-seemls coated 


mene 


| 
| 
| 
| 


—_—_ — -——-- - — 
i 


F 4 
— COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement \2=ge0n 1386 $3: 28:66 AX-11 Oi tegen eh es 
1-018 COBSACC_SCR = ACCEPT with screen enhancements 14-Sep-1984 12:10: COBRTL.SRCJCOBACCEPT.832;2 
i; 16 149 § IF (.YES_PROTECT AND 
; 16 150 ( .STRING_DEST postee treed NEQ DSCSK_DTYPE_F AND 
; 16 151 -STRING_DEST LOSCSB_DTYPE] NEQ DSCSK_DTYPE_D )) 
3 1639 1 § THEN 
'; 16460 1 i¢ 
>; 1641 154 ! If the Length of DEFAULT is greater than the expected 
; Hb a4 155 ! input size ACC_SIZE, then there is a Protection error. 
3; 1646 128 ! This should be caught at compile time by VAX COBOL and 
> 1644 15 ! a fatal error message issued, however there is one case 
> 1645 158 ! that the compiler cannot catch, therefore issue a fatal 
: MS 4 12 } run time error here. 
>; 1648 161 $ IF (. DEFAULT COSCSW_LENGTH] GTR .ACC_SIZE) 
3; 1649 198 TH 
; 1650 163 5 LIBSSTOP ( COBS_INVDEFVAL ) 
; 1651 164 5 ELSE 
3 1926 165 5 PROT_OK = 1 ! No PROTECT error 
3; 165 166 5 ELSE 
3 1654 $0 5 PROT_OK = 1 ; ! No PROTECT error 
; 1655 168 5 
; 1656 169 4 END ; ! End DEFAULT 
; 1657 170 4 
; 1658 171 & Saeeenee 
3; 1659 We 4 !eeeeene CONVERSION 
; 1660 175 & !eeeeeee ALL RMS SGETS COMPLETED EXCEPT POSSIBLE REPROMPT ON A CONVERSION ERROR. 
: 1661 $158 4 [eeneeer 
3 1oee 175 4&4 
3; 166 3176 4 !+ 
> 1664 3177 4! If conversion requested, call routine COBS$SACC_CONVERT 
3 1665 178 4 !- 
3: 1666 179 4 
; 1667 180 5 IF ( .PROT_OK ) : If protection error, | 
: 1668 3181 4 T ! don't go thru conversion 
: 1669 3186 5 IF ( .YES_CONV ) 
; 1670 183 4 THEN 
3 1671 3184 4 CONV_OK = COBSSACC_CONVERT ( .STRING_DEST, .FLAGS, 
3 1672 3185 4 -DEFAULT, PUT_HERE, .CHARS_READ, 
3; 16735 3186 4 -YES_DEFAULT, .YES_SIGN ) 
3 1674 Ht 4 ELSE 
3: 1675 188 5 BEGIN 
3; 1676 3189 5 LOCAL 
3; 1677 190 5 COPY_NUM ; 
3: 1678 191 5 : 
: 1679 136 5 ! No conversion requested - copy input data to STRING_DEST. 
3; 1680 193 5 ! Use STRSCOPY_R because it BLANK fills. 
3 1681 194 5§ !e 
; 168 195 5 
3; 168 196 5 IF .CHARS_READ LSS .STRING_DESTCDSC$W_LENGTH) 
> 1684 197 é HEN 
3; 1685 198 COPY_NUM = .CHARS_READ 
3 1656 199 5§ ELS 
$ + 4 5 ; COPY_NUM = .STRING_DESTCDOSCSW_LENGTH) ; 
3; 1689 4 STRSCOPY_R ( .STRING_DEST, COPY _NUM 
> 1690 03 6 TIF .YES DEFAULT 
3; 1691 04 3 THEN .DEFAULT pscea POINTER) 
3 1692 05 ELSE .PUT_HERE CDSCSA_POINTER] )) ; 
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: 1693 
3; 1694 
; 1695 5 CONV_OK = 1 ; ! set CONV_OK to success 
; 16 09 4 ND; 
3; 169 10 4 
3 1998 11 4 '¢ 
3 i$ i 4 ! Conversion completed - was it successful ? 
; 1700 1 4 fe 
3 1701 14 4 
: 1708 15 4 IF .CONV_OK EQL 0 
; 170 1 4 THEN 
3 1708 17 4 1¢ 
3; 1705 \8 4 ! CONVERSION error. Read UNIT parameter to determine what 
3 178 19 & ! to do. 
3; 170 0 4 : 
3; 1708 1 4 : Byte 2 of Conversion 
; 1709 ¢ 4 : UNIT error 
: 1710 4 ' 
31711 4 4 : 0 reprompt 
3 Har 5 4 : 1 ( at end ) reprompt 
3 171 $ 4 ‘ 2 ( on exception ) return 
3 1714 & Hoe 
3 1715 8 2 BEGIN ! Begin conversion error 
3; 1716 9 IF ( .FLAGS AND V_COB_RPG ) NEQ 0 
3 1717 § 0 5 THEN 
; 1718 ss : \ . 
: 1719 2 ¢ 2 ! VAX RPG = return on a Conversion Error, ring bell 
: 1720 $3 ! and clean up before exiting. 
3 1721 3% (5 - 
3 17 ¢ tH 6 BEGIN 
3 17, 6 6 COBSSRMS_PUT_BYTE ( RING BELL, .FLAGS ) ; 
: 1724 237 6 COBSS$RPG_CLEAN_UP ( .FLAGS ) ; 
: 1725 8 g RETURN 0 ; 
3 17 $ 39 END ; 
3 17 40 : 
: 1728 41 IF .UNIT C1) EQL 2 
3; 1729 rk} 5 THEN 
3 17 43 6 BEGIN 
3; 1731 44 6 '¢ 
3 17 ¢ 245 6 ! Clean up before returning control to VAX COBOL. 
3 173 “508 6 be 
3 1734 47 6 oP Se al ( PARAMETERS, .FLAGS ) ; 
3; 1735 48 6 RETURN O ; 
s 17 49 END 
3 17 50 ELSE 
3; 1738 51 '¢ 
3; 1739 $26 ! Reprompt 
3; 1740 1 : = sound terminal bell, 
3 1741 54 ; - clear screen of all typed characters, 
: 1766 22 - reset cursor to original Line/column position 
3 17446 2 § BEGIN 
3: 1745 58 IF ((.FLAGS AND V_NO_ECHO) NEQ 0) OR (.YES_DEFAULT ) 
3 1766 59 $ THEN 
3; 174 60 BEGIN ! No re-positioning 
3 1748 61 7 COBSSRMS_PUT_BYTE ( RING_BELL, .FLAGS ) ; ! necessary 
3 1749 262 7 END 
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; 1750 63 ELSE 
3; 1751 64 BEGIN 
; if § 65 { cranen REPROMPT ; ! Re-position 
: 1754 89 6 CONV_OK = 0 ; ! Signal Conversion error 
3; 1755 re YES_BEFAULT = 0 ; 
3; 17 : § END ; 
3; 17 0 END ! End conversion error 
3; 1758 71 
3; 1759 72 & ELSE 
; 1760 73. 4 '¢ 
3; 1761 74 «4G ! Conversion not done either because Protection failed (PROT_OK=0) 
3 1766 75 4 a or there was no data to convert 
3; 176 76 & : 
3 1764 77 & CONV_OK 1; 
3; 1765 78 4 
3 4 6] 79 END ; ! End loop 
3; 176 80 
3 1768 81 '¢ 
3: 1769 S ! RMS S$GET complete - fill in optional LENGTH parameter with the 
; 1770 8 ' number of characters read. 
3; 1771 84 l= 
3 Ieee 85 
3 He, Hy IF NOT NULLPARAMETER (LENGTH) 
3 1775 88 «LENGTH = .CHARS_READ ; 
3 177 89 
: 177 90 ‘eeeneee 
3; 1778 91 jeeeeece CLEAN UP 
3; 1779 9 igeeeee 
; 1780 9 
3; 1781 94 '¢ 
3 He 4 295 ! Call COBSSCLEAN_UP to perform (if needed) cursor positioning, 
3; 178 $36 ! turn off terminal attributes, and advancing. 
3 1784 e9 te 
3; 1785 98 
3 HA ” COBSSCLEAN_UP ( PARAMETERS, .FLAGS ) ; 
3; 1788 301 END; ! End $GET 
3; 1789 30 
: 1790 0 '¢ 
3 1791 04 ! Free local strings PUT_HERE 
3 18 305 t= 
3; 179 $09 
3: 1794 0 If NOT tL sresrees 1_Dx Bas WERE a" 
3: 1795 $8 THEN LIBSSTOP ( COBS$S_ERRDURACC 
: is 09 
; 179 10 
; 1798 11 RETURN 1; - 
3; 1799 12 END; ! end of routine COBSACC_SCR 
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OFFC 00000 
5E EBFO CE 9€E 0008 
OC AE 04 0000 
7t Fe doooe 
—E 7C¢ 
7E 7C 0 
1 DO oR 
6 D4 0001 
94 AD BE AF 0058 F 28 00014 
8 D4 Baie 
4 AE Dd 45 
4 AD 02100000 F DO 000 
98 AD D4 OO002A 
59 oc a DO 0002D 
04 59 05 €1 00031 
08 AE 9) DO 00035 
9 95 00039 
02 18 00038 
+3 D4 er 
03 59 0 59 003F 
OOFC 31 00043 
DO 3= AD 01 DO 00046 
14 AC 05 QO04A 
08 13 0004D 
AC AD 14 AC Bo 0004F 
OOF1 31 00054 
52 D4 00057 
50 08 AC 00 00059 
52 09 AO 9A 0005D 
51 08 AO 98 00061 
52 51 CO 00065 
AC AD 60 B80 00068 
54 D4 0006C 
09 03 AO 91 OO06E 
68 12 1 
54 06 0074 
52 05 00076 
05 19 00078 
08 AO 95 QOO7A 
60 15 Baooe 
56 01 00 0007F 
33 BS 0008s 
11 rf 0086 
53 3 0088 
51 08 ag OO8A 
9 18 000 
51 1 43 00 
AC AD 51 8B 94 
98 11 0009 
AC A 2 4 0099 
3 08 AE CE Bae 
nc AR be Satu 
51 0 AO BR Oar 
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SIZE, ACC_SIZE 
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P99 
TRING_DEST, RO 
(RO), "PPO 
8(RO). R1 
R1, PP99 

(RO), ACC_SIZE 
R4 
3(RO), #9 
13$ 

4 
PP99 

x 
8(RO) 
13$ 
#1, P_DATA_TYPE 
R3 
PP99 
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R3 
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R1, ACC_SIZE 
PP99, ACC_SIZE 
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0 AC AD 80 00148 21$:  MmOVW ACC_SIZE, PUT_SIZE 3 2481 
0398 ap AC AD 6} 16¢ CHP pe9 9920 + 2482 
50 AC AD §2 Ai 154 ADDWS #5, ACC_SIZE, PUT_SIZE : 
94 AD 9F 00159 228:  PUSHAB PUT_HERE + 2684 
20 AE 50 3¢ 001 MOVZWL PUT"SIZE, 32(SP) : | 
“a 20 AE OF 0016 PUSHAB 32(SP) : 
000000dus 00 9 FB 16 CALLS #2, SIRSGET1_DX : | 
0D E8 OO16A BLBS 3 : | 
000000006 g DD 0160 PUSHL #COB$_ERRDURACC + 2485 
000000006 99 1 FB 001 CALLS #1, LTB$STOP : | 
e 04 AC 3A Ozh 23$ MOVZ2BL UNIT, R + 2493) 
06 5 1 0017E CMPBOR2, #6 : 
0D 1B 00181 BLEQU 24 : 
000000006 8F DD 00183 PUSHL #COBS_INVARG + 2495 
000000006 00 01 FB 00189 CALLS #1 L T8SSTOP : 
14 AE 0000000060042 DE 00190 248:  MOVAL  COBSSAL_WRITE_RABLR2], 20(SP) + 2497 | 
14 BE D 00199 TSTL  a20(SP) : 
11 12 0019¢ BNEG 27$ : 
04 59 0B £1 0019E BBC #11, R9, 25$ > 2504. 
01 DD OO1A2 PUSHL #1 : | 
02 11 OO1A4 BRB 26$ : 
7E D4 OO1A6 25$: CLRL  -(SP) ; | 
52 DD 0O1A8 26$: — PUSHL Re ; 2503 
0000v CF 02 FB OO1AA CALLS #2, COBSSOPEN_IN F 
57 14 BE DO OOIAF 27$:  MOVL a20(SP), RAB : 2508 
50 44 «OA 9 00183 MOVAB  68(R7), NAM DSC : 2519 
000000006 90 05 00187 TsTL COBSACC_TERA_TYPE : 2521 
000000006 00 9F 001BF PUSHAB COBSACC_TERM_TYPE : 2523 
7E 60 3¢ 001¢5 MOVZWL (NAM_DSC), -TSP) + 2526 
04 AO dD 001C8 PUSHL  4(NAM DSC : 2523 
000000006 00 03 FB 001CB CALLS #3, COBS$SETUP_TERM_TYPE ; 
0D 50 £8 001D¢ BLBS : 
000000006 8F DD 001D PUSHL #COB$_ERRDURACC : 2526. 
000000006 00 01 FB 00108 CALLS #1, LYBSSTOP ; | 
00000006 00 05 OO01E2 28%:  TSTL COBSACC_TERM_TYPE : 2528. 
46 12 OO1E8 BNEG i$ : 
6E DD OO1EA PUSHL YES_ : 2539 | 
AD DD OOteC PUSHL YES~PROTECT ; | 
10 AE DD OO1EF PUSHL YES~CO : 2538 
94 AD 9F Oo1Fe PUSHAB PUT-HE > 2537 | 
7E AC AD 3C OO1F MOVZWL ACC7SIZE, -(SP) : 2538 | 
1€¢ AC DD 001F9 PUSHL LENGT : | 
10 AC DD OO1FC PUSHL DEFAULT : 2537 
59 bp OOirF PUSHL R9 : 
7E 04 AC 7D 00201 MOV «UNIT, -(SP) F 
0000v CF A FB 0 05 CALLS #10, COBSSACC_SCR_FILE ; 
52 0 p 020A MOVL RO, STATUS : 
94 AD 9F 0020D PUSHAB Py _HERE > 2543 
000000006 00 1 FB 6 19 CALLS #1, ~STRSFREE1_DXx : 
0D O€ 1 BLBS : 
000000006 8F DD O021A PUSHL #COB$_ERRDURACC > 2544 
000000006 00 1 FB 9 CALLS #1 LTBSSTOP ; | 
0 : 298:  BLBS STATUS, 30$ > 2546 
0542 31 A Rw 106$ ; 
0538 31 0022D 308:  BRW 105$ F 
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00000000" EF 0 31$:  MOVL #1, ACC_SCR 
5 000000006 0 9A 7 MOVZBL ¢ S$SAB-PREV, RO 
02 g 4 4 CMPB SséRO, «#2 
1 4 BEQL «= 3 
04 0 91 0024 CMPB SsoéRO, #4 
09 12 00248 BNEQ  33$ 
9 DD 0024A 32$ PUSHL R9 
1 DD 0024¢ PUSHL #1 
0000v cf : FB 00 af CALLS a2, COBSSRMS_PUT_BYTE 
4 Fe 0255 33$: EXTZV #0, #4, RO, PUT_PLAG 
2C 13 00259 BEQL 34 
E8 AD 9F 00258 PUSHAB OFF_LEN 
oC AD 9F 0025E PUSHAB OFF ~BUF 
28 AE OF 00261 PUSHAB ON_CEN 
EC AD OF 99 64 PUSHAB UF 
D8 AD DD 00267 PUSHL PUT FLAG 
000000006 00 DD 0026 PUSHL COBSACC_TERM_TYPE 
000000006 00 06 FB 00 29 CALLS #6, COBS$SET-ATTRIBUTES_ONLY 
0 0 €8 0027 BLES) saR 
000000006 8F DD 0027A PUSHL #COBS$_ERRDURACC 
000000006 00 01 FB 00280 CALLS #1, LYBSSTOP 
oc 59 04 El 00287 34$: BBC #4, R9, 35 
50 EC AD 9E 0028B MOVAB ON_BUF, RO 
20 BE4O 07 90 0028F MOVB #7, @0N_LENCROJ 
20 AE D6 00294 INCL ON_LEN 
06 6C 91 00297 35s: CMPB sé AB), #6 
58 1F OO029A BLSSU 
18 AC D5 0029¢ TSTL  24(AP) 
53 13 0029F BEQL 
28 AE 18 BC 3C 002A} MOVZWL @KEY, KEY_LEN 
24 AE 9F 0026 PUSHAB BLANKS 
2C AE 9F 002A9 PUSHAB KEY_LEN 
18 AC DD OO2AC PUSHL EY 
000000006 00 03 FB OOgAE CALLS #3, STRSDUPL_CHAR 
07 6C 91 00286 CMPB sé AP), #7 
05 1F 00289 BLSSU 36$ 
1c «=AC OSS 00388 TSTL 28(AP) 
34 12 08 BNEG 41$ 
05 6C 91 002CO 36$: CMPB (AP), #5 
05 1F 002¢ BLSSU  _37$ 
14 AC 05 dog¢ TSTL 20(AP) 
2A 12 002C8 BNEG 41$ 
04 6c 91 0 CA 37$:  CMPB (AP), #4 
05 1 002CD BLSSU - 38$ 
10 AC DS O02CF TSTL 16(AP) 
20 ie 002D2 BNEG 41$ 
02 6C 91 00204 38$:  CMPB (AP), #2 
05 1 00207 BLSSU -39$ 
08 Ac D5 6 D9 TSTL B¢AP) 
16 1 na BNEQ 41$ 
18 AC DD OO2DE 39%:  PUSHL KEY 
59 DD 00261 PUSHL R9 
04 AC DD 002E3 PUSHL UNIT 
0000v CF FB 0266 CALLS #3, COBSSFORMAT_FOUR 
03 5 O2EB BLBS RO 40$ 
047E 31 OO2EE BRW 106$ 
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0477 31 Fi 40$: 
18 Ag D4 F4 418: 
OF 59 09 €1 F7 
8 AE 6 FB 
BS AD 524 ; FE 
04 AE 1 00 04 
6 11 00308 
B4 AD 5200 , 2 3 OA +38: 
A D 9 43$: 
08 13 0031 
10 08 48 oost7 
041C 31 $6 19 
58 D4 OO31C 448: 
oc A b OO aa 
03 13 00 $1 
008D 31 00323 
03 000000006 99 D1 B08 6 45$: 
5 12 00320 
51 DO 830 AD 5 003eF 
FE68 CD EC AD 0 AE 28 00333 
56 0 AE 00 00338 
AC AD 20 6E 00 2C 0033F 
FE68 CD46 00345 
50 AC AD 3C 00349 
56 50 CO 0034D 
AC AD 08 6E 00 2C 00350 
FE68 CD46 00356 
50 AC AD 3C€ QOO35A 
56 50 CO 0035E 
000003F2 8F 56 D1 00361 
OD 15 00368 
00000000G 8F DD 0036A 
000000006 00 01 FB 00370 
0240 8F B8B 00377 468: 
FE68 CD 9F 00378 
0000v CF 03 FB 0037F 
20 A b3 Oo aes 47$: 
13 13 00387 
01 DO 6AD CO Ootee 
OD 13 00380 
59 DD 0038F 
24 AE dD 00391 
EC AD 9F : 94 
0000v CF 0 Fe 97 
57 14 BE 00 0059C 48$: 
98 AD go OSA 
7E AC AD 3C QOSA 
B4 AD ODD OO3A 
57 DD AA 
0000v CF 4 4 AC 
a. % Bl 
9g A 4 00383 49 
BO AD A C 00386 50 
B8 AD —E A? 9A 0038 
BC AD C A? 9A 0035C 
000181¢C8 8F 08 a7? 01 005C 


MOVZWL 
a 
MOvC 


MOVZWL 
DL2 


pa19B4 12:10: 
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105$ 
24 (SP) 
#9, RI, 428 

24 (SP) 

#21056 FUNC_VAL 
, YES_NO_ECHO 


#20992, FUNC_VAL 
PROT_OK 

CONV_OK 

44 

TERM_SEEN 
REPROMPT_DONE 

45$ 

49$ 
COBSACC_TERM_TYPE, #3 


YES PROTECT, 47$ 
ON_CEN, ON_BUF, FIELD_BUF 


ON_LEN, FI 
#0, (SP) 


& "DPrmawrYrrnm 


#COBS_ERRDURACC 

#1, LTBSSTOP 

#*M<R6,RI> 

FIELD BUF 

#3, COBSSRMS_PUT_BUFFER 
ON_LEN 


48$ 
{hp_PRorec. #1 
48$ 
R9 


ON_LEN 
ON" BUF 
#3- COBSSRMS_PUT_BUFFER 
a20(SP), RAB 
PUT_HERE+4 
ACC“SIZE, =(SP) 

T_VAL 


#4, COBSSRMS_GET 
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1 CD BNEQ 51$ : 
58 of 8 CF MOVL #1, _TERM_SEEN + 2790 
% AC BD be PUSHL UNIT : 2791. 
4 AD 9F 0030 PUSHAB PARAMETERS ; | 
0000v cf 0¢ FB 6 D8 CALLS #2, COBSS$PARTIAL_SEQ : 
7F OS oc aA’ 91 Dp 51$: CMPB  12(RAB), #127 t 2798 
D 12 0 E BNEQ 52$ : 
9 DD 003E4 PUSHL R + 2800) 
04 AC DD 003E6 PUSHL UNIT : 
94 AD 9F 003E9 PUSHAB PARAMETERS : 
0000v CF 03 FB O3EC CALLS #3, COBSSDELETE_KEY : | 
03 DO AD : 0 Fi a8: BLBS YES PROTECT, 548 + 2825. 
00OA8 31 003F5 53$:  BRW 6 : 
BO AD D3 O3F8 54$: =“ TSTL HARS_READ + 2826 | 
F8 13 OO3FB BEQL $ : | 
00018188 8F 08 A? D1 003FD CMPL (RAB), #98744 + 2828 
FE 12 00405 BNEQ : 
D5 00407 TSTL TERM SEEN 3 2829) 
EA 12 00409 BNEG 53$ : 
53 4 00408 CLRL §_-NO_CHAR + 2831 
52 D4 0040D 558: CLRL HAVE_TERM : 
01 52 D1 OO4OF 568:  CMPL HAVE-TERM, #1 : 2850) 
03 12 09412 BNEQ 57$ : 
oog¢ 37 00414 BRW : 
) b4 00417 57$:  CLRL  NO_CHAR : 2853 
1c AE 5240 BF 3C 00419 MOVZWL #27056, FUNC_VAL_2 + 2855) 
57 14 BE DO 0041F MOVL  a20(SPS, RAB >; 2857 | 
AO AD 9F 00423 PUSHAB NEXT_CHAR ; 2858 | 
01 DD 00426 PUSHL #1 : | 
24 AE DD 00428 PUSHL FumwC_VAL_2 : 
57 DD 00428 PUSHL R ; 
0000v CF 04 FB 00490 CALLS #4, COBSSRMS_GET : 
22 A? «BS 004 : TSTW  34(RAB) + 2868 | 
08 12 0043 BNEQ 58$ : 
53 01 D0 00437 MOVL #1, NO_CHAR : 2871) 
AQ AD A7 90 0043A MOVE 12(RABY, NEXT_CHAR : 2872 | 
BB AD OE AZ 9A 0043 58$:  MOVZBL 14(RAB), TERM~SIZE 3 2874 
BC AD A? 9A 00444 MOVZBL 12(RAB), TERM7LOC : 2875 
C4 «AD 01 DO 90449 MOVL #1, TERM_IN_NEXT : 2876 
000181¢8 + F 08 AT ODI Bocup cMPL — BCRaB), #98760 : 5877 
0B 12 0495 BNEQ 9$ : 
04 AC DD 0045 PUSHL UNIT : 2879 
94 AD 9F 0045A PUSHAB PARAMETERS : 
0000v CF 9¢ 4} 45 CALLS #2, COBSSPARTIAL_SEQ é 
gp E9 00462 59$:  BLBC  NO_CHAR, 62$ > 2886 | 
A 01 09 46 MOVL #17 PROT_OK : 2889 | 
52 01 B 04 MOVL #1. HAVE-TERM + 2890 
7F = oF 0c AZ? 91 004 CMPB 1e{RAB). #27 3 2901 
9D 12 004 BNEQ  56$ : 
59 DD 0047 PUSHL > 2904 | 
04 AC DD 0047 PUSHL UNIT ; | 
94 AD 9F 00477 PUSHAB PARAMETERS F 
0000v CF 03 FB OO47A CALLS #3, COBSSDELETE_KEY F 
B8 AD p 47F TSTL TERM_SIZE : 2910 | 
6 4 BNEG ; 
D4 004 CLRL -HAVE_TERM : 2913. 
A D4 004 CLRL —- PROT=OK > 2914 | 
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Hist 
isrcihn 


"5 COBSSRMS_PUT_BYTE 
PROT_OK 


ei near 


#1, PROT_OK 


PROT_OK,~70$ 
TERN IN. NEXT, 65$ 
TICHAR, TERM_PTR 


GHARS READ. Jf PUT_HERE+4, TERM_"TR 
(Foe re TERM_PTR 
12(RAB), RO 
RO, #9 
67 
RO #13 
(AP), #6 
g4 (AP) 

0$ 
KEY, RO 
@TERM_PTR, @4(RO) 
RO, #26 
69$ 
#11, R9, 718 
R9 
PARAMETERS 
rei COBSSCLEAN_UP 
ao #127 
1§ 
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IT 
PARAMETERS 
COBSSDELETE_KEY 
LEGAL 
16s 

CARS READ 
(RAB), #98938 
#11, R9, 75$ 
R9 


PARAMETERS 
#2, COBSSCLEAN_UP 
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| SORSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 1 
| 18 COBSACC_SCR = ACCEPT with screen enhancements 1 
52 0D C 
06 aC OD i 73$ 
0000v CF 9 ° 4 
02 28 
06 o¢ 1 49 74$: 
18 AC DS OOReE 
fF 8 O08 
52 00 005 
ee AD 43 5 
C A F 005 
000000006 99 9 Fe 2 
1 E 6 
CC AD 04 00565 75$: 
; DD 00568 
DD 0056A 76$: 
046 ac Bo i 
94 AD F b296 
0000v CF 4 FB 005 $ 
2 04 00577 77$: 
BO AD 05 00579 
10 12 0057C 
52 D6 OO ark 
OA 59 0B €1 0058 
59 DD 00584 
0000v CF 01 FB 00586 
01DD 31 00588 
45 52 9 OOS8E 78$: 
04 6C 91 00591 
40 1F Bo ane 
10 ac t) 0596 
38 13 00599 
D4 §=6—AD «ODS 00598 
36 «(12 ait 
BO AD 10 6C 3C OOSA 
D4 = AD 01 DO OOSAS 
26 DO AD €E9 OOSA9I 
50 08 AC 00 OOSAD 
OA 02 ad 91 00581 
1c «(13 ppees 
08 02 ad 91 00587 
Z 16 13 00588 
AC AD 10 Cc B61 pees 
Ped F 18 bat 
00000000G 8F ODD C4 
00000000G 00 1 FB OOSCA 
‘ 3 11 00501 
SA _ 01 dO Be0e 79$: 
SA ‘ A €9 00 8 80$: 
20 08 AE €9 D 
6— 0D DD 
D4 AD DD OOSDF 
BO AD pp bee 
94 AD F E 
10 AC OD OOSE 
59 DD OOSEB 
08 AC DD OOSED 
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Wy OBSSCONTROL z 
154s ¥ 


; COBSSCONTROL KEY 
AMETERS 
SSILLEGAL_TERM 


COBSS$RPG_CLEAN_UP 


o@o—oo 
ome 
AVA 


AULT, CHARS_READ 
FAULT 


@DEFAULT, ACC SIZE 
#COBS_INVDEF VAL 
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— COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 15-sep-1984 2 £54 232 AX-11 Bliss-32 V4 20-748 Page 44 
/ 1-018 COBSACC_SCR = ACCEPT with screen enhancements 14-Sep-1984 12:10: COBRTL.SRCJCOBACCEPT .8352;2 (4) 
000000006 00 7 FB FO CALLS #7, COBSSACC_CONVERT ; 
| 1 AE 0 f fe post RO, CONV_OK : 
BO AD 08 BC 10 FD 81S:  CMPZV #0, #16, @STRING_DEST, CHARS_READ ; 3196 
| é BLEO : | 
2c AE B0 AD 0 6 wOVL HARS_READ, COPY_NUM : 3198 
bd | 
2c AE 08 BC x 6 Bes: MOVZWL @STRING_DEST, COPY_NUM : 300 
D4 #AD OE 1 $: BLBC YES DEFAULT, 84$ : 320 
0 10 ac 00 0061 L ‘DEFAULT, RO 3 3204 
04 AO DD OO61A PUSHL 4(RO : 
03 11 9610 RB 85$ : 
98 AD DD 0061F gus PUSHL PUT_HERE+4 ; 3205 
30 AE 9F 00622 85$ PUSHAB COP 3 3202 
08 aC DD 906 PUSHL ST : 
000000006 00 03 FB 006 8 CALLS #3, STRSCOPY_R Fees 
10 Ae b 906 3 86$ TSTL = 3 3215 
03 13 006 BEOQL : 
OOF6 31 00638 BRW 1018 : 
12 59 0B £1 00638 87%: BBC #11, R9, 88S 3 3229 
59 DD 006 F PUSHL 9 : 3236 
02 DD 00641 PUSHL ae : 
0000v CF 02 FB 00643 CALLS #2, COBS$RMS_PUT_BYTE : 
59 DD 00648 PUSHL : 3237 
0000v CF 01 FB 0064A CALLS #1, COBS$RPG_CLEAN_UP : ; 
10 11 0064F BRB ; 3238 
02 05 AC 91 00651 88$: CMPB  =sCUNIT#1, #2 3 3241 
OD 12 00655 BNEQ 90S : 
59 DD 00657 PUSHL R9 : 3247 
94 AD 9F 00659 PUSHAB PARAMETERS : 
0000v CF 02 FB 9065¢ CALLS #2, COBS$CLEAN_UP : 
0108 31 00661 89$: BRW 106$ : 3248 
04 18 AE €E8 00664 90$: BLBS 24(SP), 91$ : 3258 
0c D4 AD E9 00668 BLBC YES_DEFAULT, 92$ : 
59 DD 0066C 91$: PUSHL 9 : 3261 
02 DD 0066 PUSHL @# : 
0000v CF 0088 Fe 067 CALLS #2, COBSSRMS_PUT_BYTE 5 ams 
56 D4 00678 92$: CLRL = PUT_TOTAL > 3264 
58 D4 0067A CLRL INDEX 3 
59 DD 9067¢ PUSHL : 
0g DD 0067 PUSHL ae : 
0000v CF 0 FB 068 CALLS #2, COBSSRMS_PUT_BYTE ; 
04 Ac D5 006 TSTL YES_NO_ECHO ; 
59 12 00688 BNEQ 96$ : 
5B 4 O68A CLRL —s R11 : 
D8 AD b 068C TSTL PUT FLAG : 
12 13 0068F BEQL 93$ : 
5B Dé 00691 INCL = R11 : 
DO AD D5 00693 TSTL YES PROTECT F 
0B 1 B08 NEQ 93$ $ 
30 AE DC AD eg AD 28 0069 MOVC3 OFF_LEN, OFF_BUF, RESTORE_CURSOR : 
56 £ AD o9 69F MOVL OFF LEN, PUT~TOT : 
58 56 DO 006A3 93$:  MOVL PUT TOTAL, INDEX : 
51 26 BO AD (C1 006A6 ADDL3 CHARS_READ, PUT_TOTAL, R1 : 
0 FF AG SE O06AB MOVAB =-1(R63, P : 


eRe oo ESNet Ree eeeeE ER: 
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Rear COBSACC_SCR = ACCEPT with screen enhancements 12-Sep-1984 13:70:98 COBRTL.SRCJCOBACCEPT .852;2 ~ (4) 
F 
0 AE Ex] 
1 AE MOVB #32, RESTORE CURSOR+1C INDEX] 
2 AE RESTORE _CURSOR+2[ INDEX] 


68 MOVB ’ 
ADDL2 #3, INDEX 


} 4$ 
#3, CHARS READ, RO 


as 
—_ 
peje lojlelololololo} 


BRB 958 
: 948: MOVB i RESTORE attri, 


0 BO MULL 
ADDL2 RO, PUT TOTAL 
BLBC =O «R11, 96 
D0 TSTL YES_PROTECT 
BNEG 968 
30 AES6 EC AD 30 MOVC3  ON_LEN, ON BUF, RESTORE_CURSORCPUT_TOTAL] 
56 ADDL2 ON-LEN, PUT_TOTAL 
968: CLRL LAST_WRITE 
97$:  TSTL AST“ WRITE 


OOO "FOOD -—-MMoOoIwWow— 


000003F2 BF CMPL  PUT_TOTAL, #1010 
MOVZWL #1010, P 
98$ MOVL  PUT_TOTAL, P_TOT 
MOVL a LAST_WRITE 
04 99$ PUSHR #*M<RO,R9> 
08 PUSHAB RESTORE CURSOR 
2 


BLEQ 
50 O3F2 TOT 
56 SUBL2 P_TOT, POT_TOTAL 
R 97$ 
50 : 
51 
0201 F : 
38 OA 
0000v CF 0 OBSSRMS_PUT_BUFFER 
57 14 +BE P), RAB 
98 AD USHL 
7E AC AD 
B4 AD 
57 
0000V CF 04 
OC AE 01 
10 AE : 
D4 «AD OD 
04 ] 
10 AE 01 : 
FBD8 : 
07 6C : CMPB 
OA 
1c) =A TSTL 
05 
1c) = BC B0 ‘ 
94 AD 
0000v CF 02 
94 AD 
000000006 00 gr 
0D 0 
00000000G_ 8F 
000000006 98 4 
0 1 : 
50 : 
ET 
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1 
5 
C 
2 
1 
0 
0 
1 
B 
é 
B 
0 00710 MOVL a26(S 
D 00714 PUSH PUT_HERE +4 
C 00717 MOVZWL ACC"SIZE, -(SP) 
D 00718 PUSHL  FUNT 
D oo716 PUSHL R 
B 007 CALLS #4, COBSSRMS_GET 
0 00725 MOVL #1, REPROMPT_DONE 
4 00729 100$ CLRL CONV_OK 267 
4 0072C CLRL YES _BEFAULT 268 
1 0072F RB 215) 
0 00731 101$ MOVL #1, CONV_OK 277 | 
1 00735 1068 BRW qg7) 
1 00738 103$ M (AP), #7 286 
F 007 BLSSU _- 1104 
; 0730 28 (AP) 
0 ore aove CHARS_READ, @LENGTH 88 
D ors 104$ PUSHL RO ~ 3588 
F 00749 PUSHAB PARAMETERS 
B O7ee CALLS #2, COBSSCLEAN_UP 
F 00751 PUSHAB PUT_ 3307 
8 o7 4 CALLS #1, STRSFREE1_DX 

758 BLBS RO 
D 0075 PUSHL  #COB$_ERRDURACC 3308 
8 764 CALLS) #1, LTBSSTOP 

768 105$ MOVL #1, R 3311 
4 0076E RET 
4 Orer 1068 CLRL RO 3312 
4 00771 R 
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; Routine Size: 1906 bytes, Routine Base: _COBSCODE + 0238 
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FOBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 18 -sep-1984 $3736 '86 AX-11 Oi legen Ph tes Page 47 
1-018 COBSACC_SCR_FILE = Screen enhancements for file 14-Sep-1984 12:10: COBRTL.SRCJCOBACCEPT.832;2 (5) 
3; 1801 13. 1 XSBTTL *COBSACC_SCR FILE = Screen enhancements for files’ 
| o¢ 14 1 ROUTINE COBSSACC_SCR_FILE (¢ UNIT : VECTOR (2,BYTE]J 
; 180 15 1 STRING DEST REF SSTRSOESCRIPTOR, 
; 1804 16 1 FLAGS, 
3; 1805 1 1 DEFAULT : REF SSTRSDESCRIPTOR, 
3% 18 1 LENGTH 
; 180 19 1 ACC_SIZE, 
3; 1808 0 1 PUT_HERE REF BLOCK (8, BYTEI, 
; 1809 Be ! Contains input characters 
; 1810 § 1 YES_CONV ! =1 if conversion requested 
: 1811 1 YES-PROTECT, i =] if protection requested 
3 7 \g 4 1 YES_SIGN ! =1 if sign should be included 
; 181 , % )= 
> 1814 $ 1 
; 1815 1 +4 
3 13\9 3 : FUNCTIONAL DESCRIPTION: 
; 1818 > EF This routine handles the VAX COBOL Version 3 ACCEPT statement 
; 1819 a oe 2 with Screen Enhancements when a file (not a terminal) is used 
; 1820 3 ¢ 1! for input. A non terminal $GET service does not contain all the 
; 1821 3 13 features of a terminal $GET service, so this routine is a scaled 
3 18s¢ ; 4 1! down version of COBSACC_SCR. Note that the fields RAB CRABS$V_ETO] 
3 Mth ; 2 : and RAB CRABSL_XAB) are not set. 
; 1825 3337 1 ! FORMAL PARAMETERS: 
3; 1826 ‘is ee 
3; 1827 3339 1! UNIT. rbu.va Array of two unsigned byte integers. 
; 1828 $ee0 &. The first byte is the unit number designating the 
: 1363 341 1! device from which the string is to be read. 
; 1850 $06 ,! The second byte indicates whether the routine should 
3; 1831 45 1! abort or return to the calling program. 
; 1eeg 344 1! Byte 2 = 0 = routine will abort on control z 
3; 183 345 1! and repronpt on conversion errors. 
3 1834 <9 1! = 1 = ( AT END ) : 
; 1835 347 1! routine will return to calling program 
: 1836 3348 1! on control z and reprompt on conversion 
3; 1837 $305 7: errors. 
3; 1838 350 1! = 2 = ( ON EXCEPTION ) 
3; 1839 ie routine will return to calling program 
; ey 326 : on control 2 and conversion errors. 
; 1346 $32¢ : : STRING_DEST.mt.ds Address of descriptor to receive the read input. 
3 H 329 1! FLAGS.rlu.v Screen enhancement flag; 
3; 1845 a ee 
3 H 94 3 358 1! bit 0 =- bold 
3 184 aoe 2 bit 1 - reverse 
3; 1848 60 1! bit ¢ - blink 
3: 1849 61 1! bit - underline 
; 1850 306 1! bit 4 = bell 
; 1851 365 1! bit 5 = conversion. 
; 1836 364 1! bit § - gee tant point is comma 
3; 185 365 1! bit - to allow space for sign in PROTECTED 
3 1854 $08 1: ACCEPT, 1 no allowance for sign 
; 1855 367 1! bit 3 - protect 
; 1856 368 1! bit = no-echo | 
; 1857 369 1! bit 10 = 0 advancing, 1 no advancing 


_—— 
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74 
COBSACC_SCR_FILE = Screen enhancements for file 14-Sep-1984 COBRTL.SRCJCOBACCEPT.852;2 (5) 


H 5 
FOBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 15-Sep-1984 ; £34338 AX-11 Bliss-32 V4.0- 


; ; 2 4 } } bit 11 = 0 for VAX COBOL, 1 for VAX RPG 

: 1860 y 1 DEFAULT.rt.dx Default source moved to destination descriptor 

3 ; 1 i : (STRING_DEST) in the event of null input. 

: , 5 f? ! LENGTH.wlu.r Destination of the number of characters read. 

; 130? 7 : ACC_SIZE.rlu.v # of characters to RMS $GET. 

; 1867 23 PUT_HERE.rt.dx Buffer to hold input characters. 

: 1869 81 YES_CONV.rlu.v Flag = 1 if Conversion requested by user. 

: 1871 85 1 ; YES_PROTECT.rlu.v Flag = 1 if Protection requested by user. 

: 1878 85 1! YES_SIGN.rlu.v Flag = 1 if sign should be included in COMP or COMP3 
Bi sae wads 

; 187% ag { IMPLICIT INPUTS: 

; Ht | $09 : ; Status of whether the input file is currently open. 

; 1880 338 { IMPLICIT OUTPUTS: 

: 1386 Be ; ! Updated status of file 

; 1884 39 i ROUTINE VALUE: 

; 1886 398 1 | If UNITE) is false : Unspecified. aerhee 

3; 1887 399 1! If .UNITC1J] is true : Either true or false, indicating success or 
: 1355 ra : EOF, respectively. 

; 1890 40¢ 1 | SIDE EFFECTS: 

; 1892 404 1! Reads a record from a designated uint. 

; 189 405 1! 

3; 1894 406 1 !-- 

3; 1895 407 1 

3: 1896 408 BEGIN 

1898 210 LOCAL 

3 1899 411 R : REF $RAB DECL 

> 1900 ate CR_BUF : VECTOR CT,BYTE), 

; 1901 41 CHARS _READ : INITIAL (6), ' Number of characters read 
3 1306 414 CONV_OK : INITIAL (0), ! = 1 if no conversion errors. 
; bt al? YES_BEFAULT INITIAL (0) ; ' = 1 if DEFAULT was used as input 
> 1905 419 BUILTIN 

g ib rt NULLPARAMETER ; 

: 1908 420 r 

: 1909 421 i RMS $PUT - If previous call requires advancing, S$PUT a Linefeed to 

; 1910 4 § ! SYSSOUTPUT. Open SYSSOUTPUT if necessary. 

: 1312 15 = 

: 1918 425 IF (.COBS$AB_PREV([O) EQL DISP 

3; 19146 426 OR .COBSSAB_PREVCO) EQL POS 


5 
COBSACCEPT = VAX COBOL ACCEPT Statement 1h-s2p-19 4 93:36:88 AX-11 Oi lege ae V4,0=74 Page $3 
COBSACC_SCR_FILE = Screen enhancements for file 14-Sep-1984 12:10: COBRTL.SRCJCOBACCEPT.B852;2 (5) 
; ' r 7 on -COBSSAB_PREV(LO] EQL ACC_ADV ) 
; | re : COBSSRMS_PUT_BYTE ( LINE_FD, .FLAGS ) ; 
51 431 '¢ 
; : r ¢ RMS $GET to accept input from a file. 
:1 434 
3 1 435 RAB = .COBSSAL_WRITE_RAB C.UNITCOJ) ; 
s 7 4 $ RAB CRAB$W_USZ] = .ACC_SIZE ; 
; i 4 RAB CRABSL_UBFJ = .PUT_HERE CDSCSA_POINTER] ; 
:4 4 § i Turn off RAB CRABSV_ETO] just in case a ‘screen enhancement ACCEPT’ 
3 ; ret was performed before this one. 
; a4 RAB CRABSV_ETO) = 0 ; 
; ; rey: WHILE SGET (RAB = .RAB) EQL RMS$_RSA DO SWAIT (RAB = .RAB) ; 
; : rr o am -RAB CRABSL_STS] AND NULLPARAMETER (DEFAULT) 
:1 448 LIBSSTOP (( IF .RABCRABSL_STS] EQL RMS$_EOF 
3 7 449 THEN 
3 3 450 + 
3 ! tt : If ON EXCEPTION or AT END, return to user program. 
3 1941 re IF .UNIT C1] EQL 1 OR .UNIT C1) EQL 2 
: 1386 454 THEN 
3 194 455 RETURN 0 
3 1944 456 
3; 1945 457 COBS_EOFON_ACC 
> 1946 458 ELS 
3 1947 459 COB$_ERRDURACC), 
: 1948 460 1, .RAB + RABSC_BLN, .RAB CRABSL_STS], .RAB CRABSL_STV] ) ; 
3 1949 461 § 
; 1950 rhe t+ 
; 1951 46 : Put number of characters read from SGET in CHARS_READ. 
3 1936 464 ! Pass this info along to COBSSACC_CONVERT. 
3; 195 465 != 
3; 1954 66 
3 1955 467 CHARS_READ = .RAB CRABSW_RSZ] ; ! Number of chars read 
3 1956 468 
3; 1957 469 lereener 
: 1958 470 !eeeeeee NULL INPUT 
; 1959 471 ‘eenerer 
: 1960 47 
3; 1961 47 '¢ 
5 1366 474 ! Null input. : 
: 196 475 ! (Check for DEFAULT parameter - if present proses to put it through 
3 1964 6 ! Conversion routines by placing DEFAULT in PUT_HERE. 
we this 
: 1969 47 BF_( .CHARS_READ EQL 0 ) AND (( .FLAGS AND V_COB_RPG ) NEQ 0 ) 
; 1308 rs ? THEN 
; 1990 {3 i In case of null input for RPG, simply return (no DEFAULT), 
3; 1971 4 ! after setting advancing flag. 
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PT = VAX COBOL ACCEPT Statement bese $1984 23:54: AX-11 Bliss-32 v4.0 
SCR_FILE = Screen enhancements for file 12-88-18 ( 76:55 COBRTL. SRC ICOBACCEP 


BEGIN 
LF (.FLAGS AND V_ADV) NEQ 0 


Bs COBSS$AB_PREV[O] = ACC_DNA 
COBSS$AB_PREV(O] = ACC_ADV ; 
Seng 1; 


' 

! There can be no PROTECTION check on input when Got tng with files as 

: RMS will only read ACC_SIZE characters or less. If .ACC_SIZE were 4 
; but the record contained ‘‘abcdef"’, only ‘‘abcd’’ will be pulled from the 
' record. RMS ignores the Ne bate characters ‘‘ef’’ and goes on to the 
! mext record. However it is possible to perform a PROTECTION check 

} when the DEFAULT value is used. 


IF ( .CHARS_READ EQL 0 ) 
THEN 


BEGIN 
—— NEQ 0) AND (.YES_DEFAULT EQL 0) 
BEGIN ! Begin YES Default 


CHARS READ = .DEFAULT COSCS$W_LENGTH); 
YES_DEFAULT = 1 ; 


+ 
! Protection check for DEFAULT excluding the Floating 
' Point data “ypee ( these will be handled in 
COBSSVERIFY_FL_RANGE. 
IF (.YES_PROTECT AND 
( .STRING_DEST PDSCSS DIVES NEQ DSCSK_DTYPE_F AND 
~STRING_DEST COSCSB_DTYPE] NEQ DSCS$K_DTYPE_D )) 
EN ' Check protsetten 
ft A Dermat COSCSW_LENGTH] GTR .ACC_SIZE) 


'¢ 
! If the Length of DEFAULT is greater than the 


! expected input size ACC_SIZE, then there is a 
} Protection error. 


LIBSSTOP ( COBS_INVDEFVAL ) ; 


END ; : End YES Default 
END ; 
‘eeeenee 
teeneeee CONVERSION 
ee 


'¢ 
! If conversion requested, call routine COBSSACC_CONVERT 


-74 
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T = VAX COBOL ACCEPT Statement 1S-sep-19 4 ¢ $36 388 AX-11 Bliss-32 V4.0-74 
CR_FILE = Screen enhancements for file 14-Sep-1984 12:10: COBRTL.SRCJCOBACCEPT .832;2 


22 
rw 
>> 


Page 51 
. (5) 


IF ( .YES_CONV ) 


CONV_OK = COBSSACC_CONVERT ( .STRING_DEST, .FLAGS 
.DEFAULT, .PUT_HERE, .CHARS_READ 
‘YES_DEFAULT, .YES_SIGN 5 


Wwn—o 


ELSE 
BEGIN 
LOCA 


pejoloflelelolololololo) 


Wu 


FwnO0Onou 


L 
COPY_NUM ; 


morrororrnororrrrrr 


14 
! No conversion requested - cop t data to STRING_DEST. 


: Y inpu 
Use STRSCOPY_R because it BLANK fills. 


If _ CHARS_READ LSS .STRING_DESTCDSCSU_LENGTH] 


eLseCOPy-NUM = - CHARS_READ 
COPY_NUM = .STRING_DESTCDSC$W_LENGTH) ; 


STRSCOPY_R ( .STRING_DEST, COPY_NUM, 
(IF .YES oa e 
THEN .DEFAULT CDSCS$A_POINTER] 
ELSE .PUT_HERE CDSCSA_POINTER] )) ; 


C 

C 

4 

; 

3 CONV_OK = 1 ; ! set CONV_OK to success 
3 END; 

4 
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14 
Conversion completed - was it successful ? 
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IF .CONV_OK EQL 0 
THEN | 


'¢ 
! CONVERSION error. Read UNIT parameter to determine what 
to do. There is no Reprompting done with Files as input. 


MONITOR 


C009 09 09 SIN SSS SSNS SDD ADA PD A AAA MII EE 


0200000000 
SES oe eS BS Aer PO OONOUE UMS ODO WO PO BO DOO SOU 2 O-DOd WON ERs 


Byte 2 of Conversion 
UNIT error 


0 COB$_ERRDURACC 
1 ( at end) | COBS$_ERRDURACC 
2 ( on exception ) Return 


GIN 

~FLAGS AND V_COB_RPG ) NEQ 0 
‘+ 

! VAX RPG = return on a Conversion Error, ring bell 
;_ and clean up first. 


BEGIN 


13 Begin conversion error 
THE 
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COBSACCEPT 
1-018 


w WANA PO PONINININPUNUNIDS 2 2 2 SS OO o 


RIDIPEPEPOPINIPIMNININONINIPIPOPINIPIPINIPOPINYI NIPPON PU POPOPononoNnny 


ce ee ce ce ee ee el ee ce ee ce ee ce ce cee ee ee el el el cl el cel cel el eld cel el eld 


A.A AA 
PAAAOX 
00 

Oo 


ANMINININNINININININ 2 2 
OONOAUE WN 0 OD NAME WIN — O ODNOAOU EWN ("OVO ONOUS WO 


EAA ODDO OSSD SAA OOD 
WWAAAAAWWw 


AA 
S33 33S 
errr 


$F 


A 
A 


T = VAX COBOL ACCEPT St 
CR_FILE = Screen enhanc 


COBSSRMS_PUT 
spusenhy che 
RETURN O ; 


on 
m 
vu 


IF UNIT C1) €0L 


RETURN 0 
ELSE 


When deal 
error mes 
where the 
be correc 
the user 
reprompti 


LIBSSTOP ( C€ 
END ; 


+ 
! Fill in optional 
: characters read i 


-LENGTH NEQ 0 
LENGTH = .CHARS 


‘eeeenree 


ieeeeeee CLEAN UP 


t10=0 ody 
Set COBS$AB_PREV 
statement that ad 
ACCEPT statement. 
called for. 


IF _(.FLAGS AND V_ADV 
COBS$AB_PREVL0) 

ELSE 
COBSSRMS_PUT_BYT 


RETURN 1; 
END; 
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5 
atement 1b-se -1984 254: AX-11 Blis 
ements for file 14-Sep-19 4 ; 75:35 COBRTL. SRC} 


BYTE ( RING BELL, .FLAGS ) ; 
ANUP ( .FLAGS ); 


2 


ing with a file, it was decided to return a fatal 
sage rather then REPROMPT. This lets the user know 
problem in the file is so that the input file can 


ted before 7 ag ge ge again. Otherwise, the 
ata 


might run out of e end of the program or t 
ng process may lead to further conversion errors. 


OBS_ERRDURACC ) ; 
! End conversion error 


LENGTH parameter with the number of 
f no error. 


READ ; 


Determine if ADVANCING is requested. 
If bi b 


ancing. If bit 10 = 1 no afyene ing, 
0] - also depending on bit 10, to flag to next COBOL 
vancing/no advancing is required following this 

Echo carriage return to screen if advancing is 


) NEQ 0 
= ACC_DNA ! No Advancing 


E ( CARR_RET, .FLAGS ) ; ! Advance via a carr 


! return 
! End of COBSSACC_SCR_FILE 


-32 V4.0 
COBACCEP 


he 


iage 


-74 
T.832;2 
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| COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement Sep-1984 23:54: AX-11 Bliss-32 V4. 
1-018 COBSACC_SCR_FILE = Screen enhancements for file 15-sep-1964 #3: 210: 38 COBRTL.SR Aescogat cer. 382: :2 nee 33 
ie beams ese oe, ee R2,R3,R4,R5,R6,R7,RB,RI,R10 3314 
ave 3 
A 9900v F 4 9002 MOVAB  COBSSRMS PUT BYTE, R10° : | 
9 0000 6 G &8F p 00 MOVL #COB$_ERRDURACC, R9 : | 
: 99000 006 00 9€ 000 i MOVAB  COBS$SAB PREV, fs : 
3 00000006 00 9€ 0001 MOV LIBSSTOP, R7 : 
E 4 5 001¢ SUBL2 #4, SP : 
5 7C OO01F CLRO CHARS_READ : 3408. 
54 04 00021 CLRL YES DEFAULT : | 
50 68 9A 90 3 MOV ZBL COBSSAB_PREV, RO : 3425) 
02 50 4 00 8 CMPB —séRO, #2 + 3426) 
9 1 B BEQL «1 : 
04 0 91 0002 CMPB sR, #4 : 3427. 
08 12 00030 BNEQ 2$ : 
OC AC DD 000 : 1$ PUSHL FLAGS : 3429 
01 DD 000 PUSHL #1 : 
6A 02 FB 00037 CALLS #2, COBS$RMS_PUT_BYTE : 
50 04 AC 9A OOO3A 28: MOVZBL UNIT, RO : 3435 
52 0000000060040 DO 0003E MOVL COBS$AL_WRITE_RABCROJ, RAB ; 
20 A 18 AC BO 00046 MOVW  ACC_SIZE, 32(RAB) + 3436 
5 1C aC DO 00048 MOVL  PUT~ R ; 3437) 
24 «A? 06 Ad DO 0004F MOVL  4(R3) 6 (RAB) : 
07 Ae 10 8A 00054 BICB2 #16, ?(RAB + 3442 
52 DD 00058 3$: PUSHL + 3444) 
000000006 00 01 FB COOSA CALLS #1, SYS$ ET : 
000182DA BF 50 01 00061 CMPL =e RO. #99034 ; 
0B 12 00068 BNEQ  4$ : 
52 DD 0006A PUSHL RAB F 
000000006 00 01 FB 9006¢ CALLS #1, SYSS$WAIT ; 
E311 0007 BRB $5" : 
3¢ 08 A2 8 00075 4$: BLBS (RAB), 10$ + 3446) 
04 6C 91 00079 CMPB (AP), #4 : 
0S 1F 0007C BLSSU5$ : 
10 AC D5 0007E TSTL  16¢AP) ; | 
32 12 00081 BNEQ 108 ; 
7E 08 A2 7D 00083 5$ MOV (RAB), -(SP) : 3460. 
44 A2 9F 00087 PUSHAB 68(RAB) : | 
01 DD OO08A PUSHL #1 + 3448. 
0001827A =F 08 A2 01 0008C CMPL  8(RAB), #98938 : | 
1A 12 00094 BNEG 8S. ; 
01 05 ac 91 90096 CMPB s«UNIT#1, #1 > 3453. 
02 os Bt OF ppooe Peek OGNIT#1, a2 : | 
0 12 oR 6$: BNEQ a3 3 
00F9 31 OOOA BRW 26$ : 
50 000000006 af d0 OA 7$: MOVL “pecs: RO ; 
DD OAC PUSHL ; 
0 1 000A BRB ; 
DD 0008 gs: PUSHL 2 > 3448 
67 0S FB 908 5: CALLS #5, LIBSSTOP ; | 
5 22 A2 3C 00085 10$:  MOVZ2wL 34(RAB), CHARS_READ : 3467 
3 D4 00089 CLRL 3 3479 
p OBB TSTL | CHARS_READ ; 
1 OB BNEG = 12$ ; 
30 D Bf INCL R : 
OE oc aC BE bet BBC #11, FLAGS, 12% : 


5 
COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 1.52 =1984 23:54: AX-11 Bliss-32 V4.0 Page 54 
1-018 COBSACC_SCR_FILE = Screen enhancements for file 127868-1 982 ; 30:35 COBRTL.SRC COBACCEPT. " 2:2 “ ay 
03 Oc ac OA €1 000C6 BBC #10, FLAGS, 11$ : 3486) 
oon 1 CB BRW 3 : | 
68 4 90 cE 11$:  MOVB #4, COBSSAB_PREV + 3490) 
0066 1 0000 BRW 25$ + 3491 
36 9 9004 12$ BLBC =: RO,-:13$ > 3503, 
10 AC OD 6 07 TSTL DEPAULT : 3506. 
1 13 OOODA BEQL 6_«13$ : 
4 05 0000C TSTL YES. DEFAULT : 
D 1 43 BNEQ : 
55 10 68C 3C 000E MOVZWL @DEFAULT, CHARS_READ + 3510 
4 1 00 00084 MOVL #1, YES_D i + 3511 
2 ‘oe € OE BLBC  YES_PROTECT, 13$ + 3519 
8 AC DO 000EB MOVL STRING * : 3520 
OA 02 Ado 91 OO0EF CMPB (RO), : 
18 13 OOF 3 BEQL 13$ : 
0B 02 Ad 91 000F CMPB =s-«-2(RO),, #11 : 3521) 
12 13 000F9 BEQL 13$ : 
18 «AC 10 BC 10 00 FD 000FB CMPZV #0 #16, @DEFAULT, ACC_SIZE ; 3523, 
09 15 00102 LEQ)Ss«s1:38 : 
000000006 8F DD 00104 PUSHL #COBS INVDEF VAL > 3530) 
67 01 FB OO10A CALLS #1, LT : 
1A 20 AC £9 0010D 13$:  BLBC veg FOV. ts + 3543) 
28 AC DD 00111 PUSHL S"SIGN : 3547 
54 DD 00114 PUSHL YES DEFAULT : 
28 Je 00116 PUSHR #*MZR3,R5> : 3546 
7E 0c AC 7D 00118 MOV ~—s FLAGS 5 (SP) : 3545 
08 AC DD 0011C PUSHL  STRING_D : 
000000006 00 07 FB OO11F CALLS 7, COBSSACC _CONVERT : 
56 50 D0 00126 MOVL 0. x : 
30 11 00129 BRB 19$ : 
55 08 BC 10 00 €D 00128 14$:  CMPZV #0, #16, @STRING_DEST, CHARS_READ : 3558) 
0S 15 00131 BLEQ 5$ : 
6E 55 pO 00133 MOVL § CHARS_READ, COPY_NUM : 3560 
04 11 00136 BRB 16$ ; 
6E 08 Bc 3¢ 001 8 15$:  MOVZWL @STRING DEST, COPY_NUM : 3562 
09 54 €9 0013C 16$: BLBC YES DEF FUL , 178 : 3565 
50 10 AC 00 0013F MOVL DEFAUL : 3566 
04 AO DD 00143 PUSHL PrRON : 
03 11 00146 BRB 18$ ; 
04 A3 DD 00148 178 PUSHL  4(R3) : 3567 
04 AE 9F 00148 18$ PUSHAB COPY_NUM : 3564 
08 AC OD OO14E PUSHL STRING DEST : 
000000006 00 3 FB 0015 CALLS #3, STRSCOPY_R : 
56 1 p 158 MOVL #1. CONV_OK ; 569 
2 158 19$ BNEQ 21 : 3576 
12 Oc AC B €1 001 BBC #11, FLAGS, 208 : 3591 
OC AC DD 0016 PUSHL FLAGS : 3598 
0s DD 0016 PUSHL # 3 
6A FB 00167 CALLS We, _fonssans _PUT_BYTE F 
OC AC DD OO16A PUSHL FLAGS ; 3599, 
0000v CF 1 FB 0160 CALLS #1, COBS$RPG_CLEAN_UP : 
A 11 001 BRB 6 ; 36 
02 05 AC 9 0174 208:  CMPB UNIT#1, #2 > 360 
4 13 00178 BEQL 6 ; 
9 DD OO17A PUSHL 9 : 3617. 
67 01 FB 17¢ CALLS #1, LIBSSTOP : 
16 AC D5 OO17F 218 TSTL LENGTH > 3625 | 


| Fopsaccert COBSACCEPT = VAX COBOL ACCEPT Statement 18.56 -Sep- 138% $3: 36 38 AX-11 Bliss-32 V4.0-7 
| 1-018 COBSACC_SCR_FILE = Screen enhancements for file 12: Sep-1984 COBRTL.SRCJCOBACCEPT. 8 2:2 


4 13 001 BEQL 228 
16 BC 5 00 001 MOVL CHARS READ. LENGTH 
05 OC A A 1 e8: BBC ' 0, 
6 3 0 001 $:  MmOvB “ cbbSSab. PREV 
11 001 BRB 5 & 
OC AC DD 00192 24$:  PUSHL FLAGS 
7E D4 001 CLRL. = (SP) 
ga 0 FB 197 CALLS #2, COBSSRMS_PUT_BYTE 
0 p 194 25$: MOVL #1. R 
4 00190 
50 D4 19 26$: CLRL RO 
4 001A RET 


; Routine Size: 417 bytes, Routine Base: _COBSCODE + O9AA 


Lad 
> 


CCEPT C CEPT = VAX COBOL ACCEPT Statement -1984 23:54: AX-11 Bliss-32 V4.0-74 
58 NIN = Open for INPUT 138e $3:36 355 COBRTL.SRC CObaYcéoT 682;2 


PL 
> 
oO 

mm 


—_-_ 


SRS SELES SLEEK Ow 
MEUM 0 ODN VEU SO ODNOUE W009 


ZSBTTL ‘COBSSOPEN IN = Open for INPUT’ 
GLOBAL ROUTINE COBSSOPEN_IN (UNIT, RPG): NOVALUE = 


es 

} FUNCTIONAL DESCRIPTION: 

Open a file for reading, given its unit number. 
FORMAL PARAMETERS: 


PAAAAAAAO 


UNIT. elev integer unit number designating the device 
from which the string is to be read. 


RPG. rl.v = 1 if RPG is cone this routine 
= 0 if COBOL is calling this routine 


ws 


' 

: 

; 

; 

; 

: 

; 

; 

; 

i 

i IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 
ROUTINE VALUE: 
; NONE 
SIDE EFFECTS: 
NONE 

= 


X_BUF = MAX(LNMSC_NAMLENGTH, NAMSC_MAXRSS); 
SFAB_DECL, 
$NAM 


RAB: RE % 
FILE_NAME: agthie 8 ' Descriptor for the file name 


TRANSLATE: BLOCK 
P: REF vec TOR 
RSLBUF : VECTOREMAX 
STATUS: 


: Determine whether the COB$xxx name is detined. 
: If so, use it. If not, use the corresponding SYS$xxx name. 


TRANSLATECDSCSB_DTYPE] = DSCS$K_DTYPE_T; 
TRANSLATELDSCSB-CLASS)_ = DSCSK“CLASS“S; 
TRANSLATECDSCSW-LENGTH] = MAX BOF; 
TRANSLATELDSCSA_POINTER) = RSLBUF; 


090000 090909 08 NIN NNN NN NNO OO 
PELSESELSSR ANAS BASSANI SSSeS 
POPPER IPEPIPOPIPINIRIPIPIPIIIIDIIII 8 tt a tt tt ts $ 
@ 
mn 
o 
— 
z 


Oe Oe Oe Be Oe Oe Oe Se Oe Oe Be Oe Be Be Ge Be Ge Se Se Ge Se Ge Se Ge Ge Se Ge Se Se Se Ge Ge Se Se Se Se Ge Se Se Se Oe Se Oe SH Oe Oe OHS SH Oe OHS OH Sees bese 
a et et el ee ee el el ee el el el el el el el el el eel el el cll el ll el cl cel ll ccs cl cells cls cel cl lt lls cll eal lt calls cls cael 


~o 
“ 


'¢ 


LIBSSTOP(COBS_ERRDURACC, 1, TRANSLATE, .FABCFABSL_STS], .FABLFABSL_STV)); 


6 

FOBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 18-soo-19 4 $3: 36:68 AX-11 Bliss-32 PPh ates Page 57 

18 COBSSOPEN_IN = Open for INPUT 14-Sep-1984 :10: COBRTL.SRCJCOBACCEPT.832;2 (6) 

3 136 708 If VAX RPG is calling this routine, bypass COB_TABLE. 

; 138 7 5 

3; 21 71 IF .RPG 

; 2200 711 N 

; 4 ne BEGIN ! Use the SYS$xxx logical 
; ¢ 71 P= .SYS [AOL EC UNIT) + BASE; 

3 220 714 FILE NAMEL DSC W_LENGTH] = tO); 

: 04 715 ILE _NAMELDSCSA_POINTER) = PC1); 

3; 2205 re D 

; 88 71 ELSE 

: 8 718 BEGIN ! Use the COB$xxx logical 
3 8 719 P = .COB rate ee + BASE; 

; 99 720 FILE_NAMECDSC -DTveE] = DSC$K_DTYPE_T; 

: 1 721 FILE NAMELDSCSB_CLASS = Dab at get ASs.5: 

3 2211 7 3 FILE-NAMECDSC$W_LENGTH] = .P 93; 

; \¢ 7 FILE _NAMELDSCS$A_ POINTER] = PC1); 

: \> se {FF RMLOG(LOGNAA = FILE_NAME, RSLBUF = TRANSLATE) NEQ SS$_NORMAL 
; $18 Use 4 BEGIN ! Use the SYS$xxx Logical 
: 2216 727 & P = ,SYS_TABLEC.UNIT) + BASE: : 

> 2217 728 4 FILE_NAMECDSC$W_LENGTH) = tO; 

3 2218 729 4 FILE-NAMECDSCSA_POINTER) = PL1); 

3; 2220 731 END ; 

3; 2221 7 ¢ 

3; de ; P 37 SFAB_INIT( 

3 222 P 3734 FAB = FAB, 

; sse P 3735 NAM = NA 

; 35 P 36 : FAC = <GEf,PUT> 

3 2226 P 373 FNA = .FILE_NAMECDSCSA_POINTER], 

3 2227 P 3738 FNS = .FILE-NAMECDSCS$W_LENGTH), 

; 2228 739 FOP = $Q0); 

3 $¢9 740 

; 2230 P 3741 > SNAM_INIT( 

: 3 1 F Ot RAM = 

; é P 374 ESA = RSLBUF, 

3 22 P 3744 ESS = NAMSC_MAXRSS, 

3 ¢e P 3745 RSA = RSLBUF, 

: 2 a6 RSS = NAMSC_MAXRSS); 

; $ 37 748 STATUS = SOPEN(FAB = FAB); 

; 2238 749 IF (TRANSLATECDSC$W_LENGTH) = .NAM WARSB_RSLJ) EQL 0 THEN 

; $23 750 IF (TRANSLATECDSC$W_LENGTH] = .NAMCNAMSB_ESLJ) EQL 0 

3: 2240 751 THEN 

3 $3 P36 BEGIN 

: 4@ 75 TRANSLATEEDSCSM_LENGTH) = .FABCFABSB_FNS); 

3 226 754 TRANSLATECDSCSA_POINTERJ= .FABCFABSL_FNAJ; 

> 2266 755 END; 

3 2245 P36 

: “6 75 

: 4 P38 IF NOT .STATUS 

3: 2248 75 

3: 2249 760 

3 0 

3 1 

3 2 


Morons 


Maw 
ANN 
oon 
wt 


IF NOT (STATUS = LIBSGET_VM(ZREF(RABSC_BLN + 8 + .NAMCNAMSB_RSLJ), RAB)? 


& 
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6t8 COBSSOPEN_IN = Open for INPUT 12re eof 93:35:88 COBRTL.SRCJCOBACCEPT.832;2 9 a) 
; 3 764 THEN 

; 4 765 LIBSSTOP(COBS_FAIGET_VM, 0, .STATUS); 

3 5 168 

3 $ 76 ! Save a descriptor for the resultant file name string, 

3 ; £88 and the string itself, after the RAB 

3 2260 771 BEGIN 

3 2261 10 LOCAL 

> 226 77 Q: REF BLOCKL,BYTE); 

: 226 774 = ,RAB + RABSC_BLN; 

> 2264 775 QCDSC$B_DTYPE)] “= DSCS$K_DTYPE_T; 

> 2265 £76 QCDSC$B"CLASS] = DSC$K CLASS S; 

; 66 77 QCDSCSWILENGTH]. = .TRANSLATELOSC$W_LENGTH); 

> 226 778 QCDSCSA-POINTER] = .RAB+RABSC _BLN+B; 

: 2268 779 CHSMOVET .QCDSCS$W_LENGTH], .TRANSLATECDSCSA_POINTER], .RAB+RABSC_BLNGS ); 

3 2269 780 END; 

: 2270 781 

+ 2071 78 \4 

: % 78 ! Initiate terminal XABTRM and include it in the RAB. 

3; 2e7 784 '- 

: 74 785 

: 2275 P 3786 SXABTRM_INIT ( XAB = XABTRM, 

> 2276 Pp 3787 ITMLST = XAB_ITMLST, 

: 2e77 788 ITMLST_LEN = ZALCOCATION (XAB_ITMLST)-4 ) ; ! SITMLST_DECL 

3; 2278 789 ' adds extra 4 

: 2279 P 3790 SRAB_INIT( 

; 2280 P 3791 RAB =. . 

3 2281 Pp 3792 FAB = FAB 

: oe 79 XAB = XABTRM); 

3; 228 3794 

: 2284 3795 IF NOT SCONNECT(RAB = .RAB) 

> 2285 796 3 THEN 

: 286 ads é LIBSSTOP(COBS_ERRDURACC, 1, .RAB+RABSC_BLN, .RABCRABSL_STS], .RABCRABSL_STV]); 

; $584 3798 é COBSSAL_WRITE_RABL.UNIT] = .RAB: 

; $55¢ 800 : COBSSAW_WRITE-IFIC.UNIT) = .FABLFABSW_IFI); 

> 2291 802 1 END; ! End of COBSSOPEN_IN 

SRMS_PTR= XABTRM 
.EXTRN SYSS$TRNLOG, SYSSOPEN 
-EXTRN SYSSCONNECT 
OFFC 00000 ENTRY COBSSOPEN, IN, Save R2,R3,R4,R5,R6,R7,R8,R9,-; 3651. 
58 000000006 00 9€ 00002 MOVAB LIBSSTOP, R11 : 
3A 00000090" EF 9€ 00009 MOVAB $RMS PTR. R10 ; 
E FE ce 4 9010 MOVAB -456TSP). SP ; 
FF4O CD O1QEQOFF &F p 001 MOVL #17694975, TRANSLATE : 3703. 
FF44 6 CD 08 AE OO01E MOVAB RSLBUF, TRANSLATE+4 : 3704. 
38 04 ac p 09 4 MOVL NIT, R8 > 3713. 
ad sh Poe Niet ares RBG Re . : 3710 
0 Fabs CF SE $0 § MOVAB BASE, RO : 3318 


oe —— eee EE ee 
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| . 
1-018 COBSSOPEN_IN = Open for INPUT 14-Sep 71982 93: :10: £88 COBRTL.SRCIJCOBACCEPT.B32;2 9 8) 
F4E3 CF47 9F 00035 PUSHAB COB TABLE R7] 
52 50 9— C1 3 ADDL3 ac SP) EpR?) : 
FFGA CD O10E 8F 80 : MOVW #270, Fee’ NAME+2 + 3720 
FFGB CD 62 B 0004 MOV7BW (P). FILE NAME : 37 é 
| FF4C CD 01 Ae 9E O00GA MOVAB 1(R2), FICE_NAME+4 : 37 
| 7E 7¢ 9090 LRQ = =( SP) : 3724. 
| 7E ps 00 CLRL = = (SP) : 
FF4O cb F 0034 PUSHAB TRANSLATE : 
E D4 00058 LRL ss = (SP) : 
FF48 CD 9F OO05A PUSHAB FILE_NAME : 
000000006 0 y FB 0005 CALLS #6, SYSSTRNLOG ; 
01 D4 006 CMPL =e RO, #1 : 
19 1 6 BEQL 2$ : | 
50 F447 CF 9E O006A 18: MOVAB BASE, RO : 3727 
F511 CFG? OF OO6F PUSHAB SYS ei ; 
52 50 9E C1 00074 ADDL3 a(SP)+, R : 
FF48 86 CD 62 98 00078 MOVZ2BW (P), FILE NAME : 3728 
FF4C CD 01 Ad 9E 90070 MOVAB -1(R2) ait NAME + : 3729 
0050 = 8F 00 6E 00 2¢ 00085 2$: movcS #0, (SP), #0, W80. $RMS_PTR : 3739) 
BO AD 5003 8F B80 0008C MOVW #20483 SRMS_PTR : 
B4 AD BF OA 0009¢ MOVZBL #64, $RMS_PTR+4 : 
C6 AD 03 90 0009 MOVE = #3, skis PIR? 2 : 
CF AD 02 90 00098 MOVB 2° $RMS PIRe3 i : 
D8 AD FFSO CD 4 0009F MOVAB NAM, $RMS_P ; 
DC AD FF4C CD DO OOOAS MOVL FILE _NAMET4. REARS matte : 
E46 AD FF48 CD 90 OOOAB FILE-NAME, $RMS_PTR+52 : | 
0060 =8F 00 6E 00 2C 00081 mMovCcS #0, TSP), #0, Ses. SRMS_PTR : 3746 
FESO 86 CD 00088 ; | 
FFSO CD 6002 8F B80 000B MOVW #24578, sams PTR ; 
FF52 CD 01 8€ 000C MNEGB #1, $RMS_PTR32 : 
FF54 «CD 08 AE 9E 000C MOVAB RSLBUF, SRMe PTR+4 : 
FFSA CD 01 8€ 000CD MNEGB #1, $RMS_PTR710 : 
FF5C CD 08 AE 9E 00008 MOVAB RSLBUF , SRMS_PTR+12 : 
BO AD 9F 000D PUSHAB : 3748 
000000006 00 01 FB 000D CALLS a SYSSOPEN : 
52 50 00 O00E MOVL tar : | 
FF4O 6 CD FF53. CD 98 000E MOVZBW aaae TRANSLATE : 3749. 
15 12 OO00EC BNEQ : 
FF4O CD FFSB CD 9B OO0E MOVZBW NAM+11, TRANSLATE : 3750. 
OC 12 O00F BNEQ 3$ F | 
FF4O CD E4 AD 9B OO0F MOVZBW FAB+52, TRANSLATE : 3753. 
FF44 6 CD DC AD 00 OOF MOVL FAB+44. TRANSLATE+4 : 3754 | 
13 52 E8 010 3$: BLBS = ST ATUS, 4$ : 3758 
7E B8 AD 7D 00106 MOVO  FAB+8, =(SP) : 3760. 
FF40 CD OF O10, PUSHAB TRANSLATE ; 
DD 0 10 PUSHL #1 : 
000000006 8F DD 0011 PUSHL #COBS ER ERRDURACC ; 
68 5 FB 00116 CALLS $STOP : 
04 AE 9F 00119 4$: PUSHAB R : 3763 
04 «AE FF53° CD OOA 116 MOVZBL NAM+3 4 (SP) : 
04 AE 0000004C SF £0 1 ADDL2. #76, &(S ; 
04 AE SF OO12A PUSHAB 4(SP) : 
000000006 00 9 FB 00100 CALLS ae | LIBSGET _VvM ; 
36 5 4 ft ; BLBS STATUS. "8 : 
52 DD 0013A PUSHL TUS : 3765 
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ett COBSSOPEN_IN = Open for INPUT 14-Sep-19 4 ; 36:88 COBRTL. aeicagavceor 82:2 9 8) 
7E D4 O13¢ CLRL = = (SP) ; 
000000006 i DD 0013€ PUSHL #COBS_FAIGET_VM : 
3 FB 144 CALLS #3, LTBSSTOP : 
§ 04 =A p 147 5$ MOVL RAB, R6 + 3774 
44 OA 148 MOVAB 68 (RG), R9 : 
0 3 D0 OO014F MOVL R : 
02 Ad 0108 F BO 001 é MOVW #270, 2(Q) : 377 
60 FF40 6 CD 8 1 MOVW TRANSLATE, (Q) : 377 
AO 4C as 5 15D MOV 76(R6), 4(0 : 3778 
4G AG FF44 DD 6 : 0162 MOVC (Q), @TRANSLATE+4, 76(R6) : 3779, 
24 00 6E 0 C 0169 mMOVCS #0, (SP), #0, #36, S$RMS_PTR : 3788 
6A 241F F B60 O16 MOVW #9247, $RMS_PTR : | 
08 AA AA . 0174 MOVAB XAB_ITMLST, $RMS_PTR+8 : 
OC AA 18 : 0179 ” #24, SRMS_PTR+12 ; | 
0044 3F 00 6E 00 C 99170 MOVCS #0, (SP), #0, #68, (R6) : 3793 
66 4401 F BO 00185 MOVW #17409, (R6) : 
a BO AD 9E 0018A MOVAB ; 
406 6A 9E 0018F MOVAB XABTRM, 64(R6) : 
56 DD 00193 PUSHL R + 3795. 
000000006 00 1 FB 00195 CALLS #1, SYSSCONNECT : | 
11 0 : 0019¢ BLBS) sa ; 
7E 08 A6 7D 0019F MOVQ 8(R6), =(SP) : 3797. 
59 DD 001A3 PUSHL R9 : 
01 DD 001A5 PUSHL #1 : | 
000000006 8F DD 001A7 PUSHL #COB$_ERRDURACC ; | 
05 FB OO1AD CALLS #5, LTBS : | 
0000000060047 9F 00180 6$: PUSHAB COBS$AL_WRITE_RABCR7J : 3799 
9 56 DO 00187 MOVL , a(SP)+ : | 
000000006004 B2 AD B80 OO01BA MOVW FAB+2, COBSSAW_WRITE_IFICR8J : 3800. 
04 001¢3 RET : 3802) 
; Routine Size: 452 bytes, Routine Base: _COBSCODE + 0B4B 


OBSACCEPT = VAX COBOL ACCEPT 
OBSSRMS_GET = Perform an RMS 


oO 
Ww 


OUTINE COBSSRMS-GET ( RAB 


SRVSEAF 


'e¢ 


i FUNCTIONAL DESCRIPTION: 


FORMAL PARAMETERS: 


IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 


ROUTINE VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 
BEGIN 
SITMLST_INIT CITMLST = 
(11M 


COD = 


0.09 09 C9 00 09 0d C9. 09 C9 C9 C9 C0 0D CD CD CD CD CD OD 


WAAL AIR POPUPUPINOPUNPNYDD 2 2 OS SO 


Ww 
WWWAANA AW AWAWANW AWA AAA AANA COO 


WN "SO OCONOUV EW "OC OOVNOvrwn—o 


vb ed 
WP 


o 


2 09 09 Cd Cd Cd Go 0d 09 C9 09 OD CD CD CD OD 
CAAA APIPIMPDMYNIMINININININININININI|IINININ IAI a ss st st tk tt kk kh 
~ 
Ld 
=Ccc 
za 
o wn 
ooe 
o 
nuun 


AAAANAAAAAAAWAA AWA 
RRR E RR RR es 
NOU SW —O0OOnN 


WAI PIPURIPIPONPININYD 2 OS Oe 


$1Z 

BUF ADR 

RAB CRAB = 
His UBF) = 

= 

= 


RAB CRABSL_XAB 
WHILE SGET™(RAB = 


IF NOT .RAB CRABSL_STS) 
THEN 


'¢ 
These are special 


if (.RAB 


W.AA.AA AAAI WIAA NAAM AANA AWA 


PRIPPIPIPPDPYANIPIPINDNINININIPNPNININPoPoNy 
eyes oo 


PAAAAMIUIVIUI 
DONO WN —OOW 


EEESELES ES 


tatement 
GET Service 


1 
1 
ZSBTTL ‘COBSSRMS_GET = Perform an RMS $GE 
ROUTI REF $R 


XAB 


e § 
5-Sep- AX=11 Bliss-32 V4.0-74 Page $1 
4-Sep- COBRTL.SRCJCOBACCEPT.852;2 (7) 
T Service’ 

AB_DE 


1984 43:10:59 
‘e 


v 
B_DEC 


) : NOVALUE = 


ITMLST, 
TRMS_MODIFIERS, 


fF UNC_VAL), 
TRMS_TERM, 


0 
MASK_VECTOR) ) ; 


' Item List for $GET 


LENGTH ; 
eBUFFER ; 


!' Extended Terminal $GET 


XABTRM ; 
-RAB) EQL RMS$_RSA DO S$WAIT (RAB = .RAB) ; 


case status that will be handled Later. 
NEQ RMS$_BES AND : Bad Escape Sequence 
n e 


* i End Of Fil 
NEQ RMS$_PES AND ! Partial Escape Seq 
Record Too Bi 


Terminator Not Seen 


———_———————_—— 


COBSACCEPT 
18 


a 


Wwrn—o 


; Routine Size: 


COBSACCEPT = VAX COBOL ACCEPT 
COBSSRMS_GET = Perform an RMS 


: 


23 00000000" EF 


80 


tatement 
GET Serv 


08 AC 


0 

80 00030014 F 
80 1c) =A 
80 

5 06 AC 

0 i oc AC 

4 A 10 AC 
07 A2 10 
40 A2 dC §3 
000000006 00 01 
000182DA =‘ &F 50 
8 
000000006 00 4 
50 08 A2 
44 50 
000181CO 8F 30 
0001827A = 8F 23 
000181C8 8F 33 
000181A8 &F 5 
00018188 &F 59 
oc 5 

5 

44 A 

gt 

000000006 8F 
000000006 00 05 
161 bytes, Routine Base: _COBSCODE 


ice 


THEN 
LIBSSTOP (COBS_ERRDURACC, 1, .RAB + RABSC_BLN, a CRABSL STS], 
END -RAB CR ) 


000C 00000 COBSSRMS_GET: 
“WORD 


9€ $0009 ROVAB 
000C CLRL 


1$: PUSHL 


23: MOVL 


BS ORMMRSBINIE ASR AAIAE FEE AAWANNIN = SSO 
WANA ONOM NUM AO MWC QUO & CO — > OWT BI MO SoM 
o 
Ss 
v 
- 


SOOOOCCOCOOCOCOOOOOOOOOOOSOOCOOOOOOOOOOOOOoSOoOo 


onmnoo 090-9 9 9 9 “9 M9 - "9 -O MNO OMOWoONOVITTYS 
So F£WOO 709A WW SI" DO DON "WO MMOOOMMoLof 
SOOoooooooooooooooooooooooooooooooooo 


i=] 
o 
aad 


COOOCOCSCOCCOOOCOOCSOOOOOOCOOOOOOOOOCOOOOOOoOoOOo 


> 
o 
Ww 
wr 
zDD 


+ 


AX-11 Bliss-32 Ph tes 
COBRTL.SRCJCOBACCEPT .B52;2 


ABSL_STVJ 


3 

SITMBLKPTR 
ITMBLKPTR) + 
+ 
T 
( 
+ 
) 


MBLKPTR)+ 
$SITMBLKPTR)+ 


DD DBD SDewD 


LENGTH, 32(R2 
BUFFER, 36(Re) 
#16, 7(R2) 
XABTRM, 64(R2) 
#1, SYSSGET 
RO, #99034 


~m 
ad 


SYSSWAIT 
§ RO 
#98752 
#98938 
#98760 
#98728 
#98744 
(R2) 

$9 (Re) 


#COBS_ERRDURACC 
#5, LIBSSTOP 


. >.> De 
— 
Uw 


D—WDWA DUA DADADDOo—-BD 
WOM PKOKHOPKOKHOKOO—H—T 
— 


roe 


Pee Se Se Se Se Se Se Se Se Se Se Se Se Be Se Se Se Se Se Se Ge Se Be Se Be Se Be Be Se Se Fe Se Se Fe Fe Fe Be Be Se 


3804 


3863. 


——$— ey 


6 
COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 15-sep-1984 ? 36386 AX-11 Oi fag 5g Ph ee 
-018 COBSSRMS_PUT_BYTE = Perform an RMS SPUT Service 14-Sep-1984 12:10: COBRTL.SRCJCOBACCEPT .B52;2 
3 5 1 ZSBTTL ‘COBSSRMS_PUT_BYTE - Perform an RMS S$PUT Service’ 
; § 65 ! ROUTINE COBSSRMS_PUT_BYTE ( WHICH, FLAGS ) : NOVALUE = 
; § be) 1 44 
; 235 508 : FUNCTIONAL DESCRIPTION: 
: 2361 676 1? This routine writes a one byte buffer to the terminal. Either a 
; ¢ se Carriage Return, Linefeed or Ring the Terminal Bell, depending 
; ors ; } on the value of WHICH. 
; 5 th : FORMAL PARAMETERS: 
5 ¢9 578 is WHICH. rl.v if 0, write Linefeed to terminal 
; 44 877 1! if 1, write Carriage Return to terminal 
3 9 3/8 1! if 2, ring terminal bell 
; 2370 879 1! 
; af ae : FLAGS.rlu.v Screen enhancement flag 
; 378 HY 1 ! IMPLICIT INPUTS: 
3 74 883 1! 
; 2375 884 1! NONE 
; 3/8 885 1! 
3; 2377 886 1 ! IMPLICIT OUTPUTS: 
3; 2378 887 1! 
3 tte 888 1! NONE 
3 2380 889 1! 
3 2381 890 1 ! ROUTINE VALUE: 
: 386 891 1 ! COMPLETION CODES: 
3 238 892 1! 
> 2384 893 1! NONE 
; Sane 894 1! 
; 2386 3895 1 ! SIDE EFFECTS: 
3 2387 896 1! 
3 2388 897 1! NONE 
; 2389 3898 1 !-- 
; 2390 899 1 
; 44 3900 BEGIN 
; 336 901 LOCAL 
; 239 90 RAB : REF $RAB_DECL 
; $398 903 CR_BUF : VECTOR CT,BYTE) ; 
3 Ha] pee IF .COBSACC_TERM_TYPE NEQ UNKNOWN 
: $05 38 BEGIN 
3; 2399 908 
: 2400 909 SELECTONE .WHICH OF 
> 2601 910 SET 
3 v5) af CO) : CR BUF CO] = CR ; ! Carriage Return 
: 2404 318 C1) : CR_BUF CO) = LF ; ! Linefeed 
; 2405 914 
3: 2406 915 C2] : CR _BuF CO) = BELL ; ' Bell 
3 2407 316 Tes 3 
; 2408 91 
3; 2409 918 COBS$$AB_USPCODE £93 = 0; 
; oe 4h COBS$AB_USPCODE [1] = 0 ; 


row $3 


6 
COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 18-56 -1984 254: AX-11 Bliss-32 V4.0-74 Page 64 
1-018 COBSSRMS_PUT_BYTE = Perform an RMS S$PUT Service 14-Sep-19 4 ; :36:88 COBRTL. sei cagatcérr o%2:2 . (B) 
: 241 921 IF .COBSSAL_WRITE_RAB (1) EQL 0 
; a1 9 ¢ i THEN 4 ye 
> 2414 9 4 BEGIN 
; 2615 924 & '¢ 
3 213 925 4 ! Open SYSSOUTPUT. Second parameter tells COBSSOPEN_OUT whether 
3: 241 9 $ 4 ' VAX COBOL (0) or VAX RPG (1) is the caller. 
: 2418 9 4 ! VMS V4 defines SYSSINPUT as read only, therefore any S$PUTs must 
3; 2419 928 4 ! be made through SYSSOUTPUT. When a terminal is the input device 
: 2420 929 4 ! for an ACCEPT it is also the OUTPUT device, and must be OPENed 
; 2421 930 4 ! for both. 
3: 246 ¢ 931 4 te 
3: 246 9 ¢ 4 COBSSOPEN_OUT ( 1 
> 2606 9335 4 If ( ,FLAGS AND V_COB_RPG ) NEQ 0 
3: 2425 934 4 THEN 
3; 2426 935 4 ELSE 0) ; 
: 2427 936 END ; 
> 2628 937 RAB = .COBSSAL_WRITE_RAB SF : 
3 2429 938 RAB RABSL REF = CR~BUF [0] ; 
5 st 0 939 RAB CRABSW_RSZ) = 1 ; 
: siz Soc; 3 WHILE SPUT (RAB = .RAB) EQL RMS$_RSA DO SWAIT (RAB = .RAB) ; 
3 seas $o0$ ; IF NOT .RAB CRABSL_STSJ 
: site toe THEN 
: 2435 944 3 LIBSSTOP ( COBS_ERRDURACC, 1, .RAB + RABSC_BLN, 
3 2436 3945 3 .RAB CRABSL_STSJ, .RAB CRABSL_STV] ) ; 
3 2437 3946 2 END ; 
: 2438 3947 1 END ; ! End of COBSSRMS_PUT_BYTE 
«EXTRN SYSS$PUT 
000C 00000 COBSSRMS_PUT BYTE: 
~-WORB Save R2,R3 ; 3865 
53 000000006 00 9 00008 MOVAB COBSSAL_WRITE_RAB+4, R3 3 
5 04 C2 000 SUBL2 #4, SP F 
000000006 00 »d5 0000C TSTL COBSACC_TERM_TYPE : 3905) 
7D 13 00012 BEQL 3 
50 04 AC hO 00014 MOVL WHICH, RO : 3909 
05 iF; poets BNEQ ; 3911. 
6E 0D 90 OOOIA MOVB #13, CR_BUF ; | 
is 11 0001D BRB 3 
01 5 if ith 1$: CMPL RO, #1 3 3913 
83 ‘ 2 BNEQ 2 3 
6E A 90 00024 MOVB #10, CR_BUF ; 
98 11 00027 628 3$ 3 
02 50 D1 00029 2$ CMPL RO, #2 ; 3915 
33 is 002C BNEQ 3$ 3 
6€ 90 0002E MOVB #7, CR_BUF 3 
000000006 09 B4 09 1 38 CLRW  COBS$AB_USPCODE : 3918 
6 9 7 TSTL COBSSAL_WRITE_RAB+4 : 3921 
14 9 BNEQ 6$ é 
04 08 AC OB CE 0 i BBC #ii, FLAGS, 4$ ; 3933 
01 OD bbe PUSHL #) ; 
Me aL BBtE ug, Bho : 
01 DD 00046 5$: PUSHL #1 ; 3932 


COBSACCEPT 
COBSSRMS_PUT_BYTE = Perform an RMS SPUT Service 14-Sep-19 


= VAX COBOL ACCEPT Statement 


000000006 9 9 
6 

3 

. 

B00 09006 go 1 
000182DA F 8 
000000006 00 Q} 
16 0 A 

e 8 8 

44 A 

01 

000000006 8F 

000000006 00 05 


; Routine Size: 146 bytes, Routine Base: 


1$-sSpe19 


FB 0048 
GF 6$: 
F 2 
B 6 
44 5 A 7$: 
BF 00088 
12 QO06A 
DD 0006C 
FB 806 
11 000 
58 0077 8$: 
D 00078 
9F OO07F 
DD 00082 
DD 00084 
0008A 


FB 
04 00091 9$: 


-COBSCODE + O0DB0 


Be 43:10:99 


AX-11 Oi lege V4.0-74 
COBRTL.SRCJCOBACCEPT.8352;2 


#2, COBSSOPEN_OUT 

COBS$SAL_WRITE-RAB+4, RAB 
BUF ,~40(RAB) 

#1- 34(RAB) 


#COB$_ERRDURACC 
#5, LIBSSTOP 


roe 5 


| Mm 6 
| COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 15-Sep-1984 1 f 30368 AX-11 Bli artic 32 V 
1-018 710: C copace 


Page 66 
COBSSRMS_PUT_BUFFER = Perform RMS $PUT Service 14-Sep-1984 COBRTL.SR . (35 


PT B32: 32 


: 2440 948 1 XSBITL ‘COBSSRMS_PUT_BUFFER = Pe there RMS SPUT Service’ 
3: 2441 949 1 ROUTINE COBSSRMS-PUT_BUFFER ( BUF ree. 

3: 244 929 1 LENGTH 

> 266 951 1 FLAGS § : NOVALUE = 

3: 24446 926 1 

3: 2445 955 1 !e¢4 

: rr 322 : 7 FUNCTIONAL DESCRIPTION: 

: ek: 328 : This routine writes buffer of more than one byte to the terminal. 
; 2450 958 1 i FORMAL PARAMETERS: 

3 2451 959 1: 

3 128 +4 : BUFFER. rt.r Holds sequence to write to screen 
3 tz Be ! LENGHT. rlu.v Length of BUFFER 

5 3056 964 1: FLAGS.rlu.v Screen enhancement flag 

: 2457 965 1: 

3; 2458 966 1! IMPLICIT INPUTS: 

3: 2459 967 1: 

; 2460 3968 1 | NONE 

3; 2461 969 1! 

g seg 970 1! IMPLICIT OUTPUTS: 

: see 971 1: 

3: 2464 3972 1! NONE 

3: 2465 973 1: 

3: 2466 974 1 | ROUTINE VALUE: 

3 2467 975 1 ! COMPLETION CODES: 

3; 2468 3976 1 

3: 2469 3977 1! NONE 

: 2470 3978 1 

3; 2471 3979 1 i SIDE EFFECTS: 

3 247 3980 1 | 

: 247 981 1: NONE 

3: 2474 982 1 i= 

3 2475 983 1 

3 2476 984 2 BEGIN 

3 2477 985 LOCAL 

3; 2478 986 RAB REF SRAB_DECL ; 

3: 2479 987 

3 2480 988 IF .COBSACC_TERM_TYPE NEQ UNKNOWN 

3: 2481 989 THEN 

3; 248 9 BEGIN 

: 248 991 

: 2484 99 COBS$AB_USPCODE fo} =0; 

; mat ok COBS$AB_USPCODE (1) = 0 ; 

: “BS 995 If .COBSSAL_WRITE_RAB [1] EQL 0 

3 rt +3 398 THEN 

: 2489 997 4 BEGIN 

: stor 998 4 '¢ 

3: 2491 999 4 ! Open SYSSOUTPUT. Second parameter tells COBSSOPEN_OUT whether 
3 ‘3 2008 ? a VAX COBOL (0) or VAX RPG (1) is the caller. 
: 2696 4002 4 COBSSOPEN_OUT ( 1 

> 2495 4003 4 If ( .FLAGS AND V_COB_RPG ) NEQ 0 
+ 26% 4004 4 THEN 1 


6 
COBSACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 18. -Sep-1984 ; $433 AX-11 Bliss-32 Vv 
1-018 COBSSRMS_PUT_BUFFER = Perform RMS SPUT Service 14-Sep-1984 12:10: COBRTL.SRC eScogatcéor. o 2:2 
: 2497 4005 4 ELSE 0) ; 
: 2498 4006 
: 2499 400 =" OBSsAL WRITE RAB C1] ; 
: 25 4008 RAB CRASSLRBFT = -BOFFER ; 
: 2501 4009 RAB CRAB$W-RSZ] = .LENGTH 
: 20¢ 4010 WHILE SPUT~(RAB = .RAB) EQL RMS$_RSA DO SWAIT (RAB = .RAB) ; 
3 2504 401g IF NOT .RAB CRABSL_STS) 
3; 2505 401 THEN 
3 2506 4014 NL 1BssToP ( COBS_ERRDURACC .RAB + RABSC_BLN, 
> 2507 4015 .RAB CRABSL “Sts. ~RAB CRABSL_STV] ) ; 
: 2508 4016 ‘ END ; 
: 2509 401 END ; ! End of COBSSRMS_PUT_BUFFER 
000C 00000 COBSSRMS_PUT_BUFFER: 
WORD Save R2,R3 
53 000000006 00 9€ 00002 HOVAB COBSSAL “WRITE_RAB+4, R3 
000000006 00 5 00009 TSTL  COBSACCTERM_TYPE 
62 13 0000F BEQL «= « 6S 
000000006 09 B4 00011 CLRW  COBSS$AB_USPCODE 
63 D5 00017 TSTL  COBSSAL“WRITE_RAB+4 
14 12 00019 BNEQ $ 
04 oc ac 0B £1 0001B BBC #11, FLAGS, 1$ 
01 DD 00020 PUSHL #1 
Se 11 00022 BRB 2$ 
7E D4 00024 1$: CLRL = (SP) 
01 DD 00026 2$: PUSHL a 
000000006 00 0¢ FB 00028 CALLS COBSSOPEN_OUT 
52 63 DO O002F 3$: MOVL COsSSAL _WRITE-RAB+4, RAB 
28 «Ao 04 AC DO 000 3 MOVL BUFFER, ~40(RAB) 
22. A 08 aC BO 000 MOVW = LENGTH, 30 (RAB) 
52 DD 0003C 4$: PUSHL RAB 
000000006 00 01 FB 0005¢ CALLS SYSS$PUT 
000182DA_ BF 50 01 9004 CMPL 4% #99034 
0B 12 0004C BNEG 5$ 
52 DD 0004 PUSHL RAB 
000000006 00 01 FB 0005 CALLS #1, SYSSWAIT 
ES 11 0005 RB 4$ 
16 08 A E68 0059 5$: BLBS (RAB), 6$ 
7E 08 Ag D 9090 Ova (RAB). =(SP) 
44 Ad 9F 00061 PUSHAB 68(RABS 
01 DD 00064 PUSHL #1 
000000006 8F DD 00066 PUSHL #coBs ERRDURACC 
000000006 00 0S FB 9006¢ CALLS #5, LYBSST 
04 00073 68: RET 
; Routine Size: 116 bytes, Routine Base: _COBSCODE + 0E42 


rae 


. : CCEPT COBSA 


COB$ 


nae 


— 2 td 2d 


NOV FW OC O0O@ 
— 
ME COON VEU "O0@ 


w 


FLLLPLLIRAGAEEREL ERE REARS 
MEW 0 ODNO VE WO OBNOUN EW 0 


Pw ot ot ot ok at od ok ah ah ah a a a nde 


Be Se Se Oe Be Se Oe Se Ge Se Se He Ge Ss Se Se Se Fe Se Ge Fe Se Se Se Se Se Se Se Se Ge Se Se Se Se Se Se Se Se Se He Se Se Se Se Se Se Se Se Se Se Ge Se Ge Ge Ge Ge Ge 
ww 
se 
=O 


Pt ot ot ot ot at ok at a 


oooo 


~~~ 


Fun—-0O0@ 


-—---— 


PAPER IPIPIPIPIFPIPIAIPAPI[PINIIPMPJIMINII|IIAI i a a ed od td 


T 


ZSBTTL *COBSSCONTROL 
ROUTINE COBSSCONTROL 


7 
NTROLLY = Handle sf) setenent WEsnctage 43:96:83 etal @4lencdbattefh 


~f + Handle “2° ‘ 
Ac unit HEFT LeseBUE Pt 
NOVALUE = 


+ 


i FUNCTIONAL DESCRIPTION: 


Read UNIT parameter to determine what to do when a Control 2 was typed. 


FORMAL PARAMETERS: 
UNIT. rbu.va 


KEY.wt.ds 
IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
WONE 

ROUTINE VALUE: 


SIDE EFFECTS: 
NONE 
BEGIN 

LOCAL 

TERM 

C2 


> 


orrey of two ung ened byte integers. 

The first byte is the unit number designating the 
device from which the str 7 is to be read. 

The second byte indicates whether the routine should 
abort or return to the calling program. 


Destination of the receiving field of the control key. 


PTR, ' Points to terminator 
PTR ; 


' Needed for CHSMOVE 


CONTROL Z = read UNIT parameter to determine what to do. 


Byte 2 of Ctrl 2 
UNIT 
9 abort 
( at end ) return 


2 ( on exception ) return 


IF UNIT C13 QL 0 
LIBSSTOP ( COBS_EOFON_ACC ) ! Abort 


ELSE 


§2:2 


Pose 18) 


7 
T9018 ——«EGBSSCONTROLY = Manale Sf) Starenent VEsietaHe G:HG:38 Wadd ObNcRbAtti"s¥o,2 Pa9e 18} 


; 4 a5 4 BEGIN 
: 4077 & i Pass CONTROL 2 back to user program via KEY, 
; re 4 ? 2 pee 
; 4 4 PTR ' C2 is Lit ux'ta’ 
3 4 ‘ cz eTR sche ee 
; 4 ; CHSMOVE 1, “TERR "PTR, .KEY CDSCSA_POINTER] ) ; 
é en 3 
; 4085 END ; . ! End routine COBSSCONTROL_2 
0000 00000 COBSSCONTROL 2: 
WORE Save nothing ; 4019 
SE 04 SuBL2 #4, SP : | 
0S ac TSTB = UNIT #1 + 6068 
E BNEQ =s«1$ : | 
000000006 8F PUSHL #coBs EOFON_ACC : 4070. 
000000006 00 1 CALLS . LTBSSTOP : 
50 08 ac MOVL KEY, RO + 4073, 
OA BEQL 3 
6E 1A MOVL PTR + 4080 
51 6E MOVAB tS One? “TERM_PTR + 4081 
04 860 61 nove (TERM_PTR), 34(RO) : 408 


; Routine Size: 41 bytes, Routine Base: _COBSCODE + OEB6 


~ 


co _ - — - — 


| ? 
| OpsaccePt COBSACCEPT = VAX COBOL ACCEPT Statement 13-sep-1984 $3: 36:88 AX-11 Bliss-32 V4.0-74 
18 COBSSPARTIAL_SEQ = Partial Escape Sequence 14-Sep-1 210: COBRTL.SRCICOBACCEPT .B852;2 

4 ZSBTTL *COBSSPARTIAL_SEQ = Partial Escape Sequence’ 
4 ROUTINE COBSSPARTIAL_SEQ ( PARAMETERS : REF eCIgR 
4 ve UNIT : VECTOR (2,6YTE] ) +: NOVALUE = 
: FUNCTIONAL DESCRIPTION: 
4 § The entire Escape sequence did not fit in the initial S$GET’s buffer. 
4 Perform 1 character Reads until the full sequence is in PUT_HERE or 
4 NEXT_CHAR, 


FORMAL PARAMETERS: 
PARAMETERS.mlu.ra Contains data for this routine. 


UNIT. rbu.va oreey of two unsigned byte integers. 
The first byte is the unit number designating the 
device from which the otring is to be read. 
The second byte indicates whether the routine should 


33 


PRIPIPIARIFP IPAM IPIPIPIAIMIAINIPINIA|IIAIIAI IR a i ee a at ed ed ee 


SESESES 


abort or return to the calling program. 
IMPLICIT INPUTS: 


SSLESRELLS 


NC-PTR, 
END_OF _TERM : INITIAL (0) ; 
‘ 


'¢ 
: Bind PARAMETERS to other names. 


$B1ND_PARAMETERS 
PH = [PUT_NERE CDSCSA_POINTER) ; 


600 
ret 
$08 — 
604 10 IMPLICIT OUTPUTS: 
$08 3 NONE 
$07 18 
ons 1 ROUTINE VALUE: 
10 1g 
11 1 SIDE EFFECTS: 
i 3 
\7 \} NONE 
16 ; BEGIN 
1 
18 4 LOCAL 
1 5 R : REF SRAB_DECL, 
0 $ FUNC_VAL_2, ' Q10 Function Modifiers for 
1 ' item List of RMS $GET. 
§ 3 TERM_CHAR BYTE, ! $GET input buffer. 
PH REF VECTOR (1100,BYTE), |! Address of PUT_HERE 
4 PH_PTR, ! Pointer to PUT HERE. 
“ 2 } Pointer to NEXT_CHAR. 
8 
9 5 
; 
5 


Be Se Se Se Oe Se Se Oe Se Os Oe Oe Ge Ge Se Se Se Se Se Ge Ge Fe Ge Se Se Se Ge Ge Ge Ge Se Se Ge Se Se Se Se Ss Se Se Se Se SH Ge Se Se Se Se Se Se Se Se Oe Ge Ge Se oe 


fot ot ot at ot ot ot ot ot ot ot ot ot nt et et tk ek kk kk dk tt tt tt nt nt at at at ot at at et et et et 


a ce ee ee ec ee ee ee ce ce el el ec ee ee ee ee ee ee ee 


FAPSPAPAPAAPAAAAPSPAAAOAAAAAAAAS 


'¢ 
! PH_PTR and NC_PTR point to next free space in buffer 


on 


| 
| 
| 
| 
| 
| 


7 
SACCEPT OBSACCEPT = VAx CogoL ACCEPT Statement 18-56 -1984 23:54: AX-11 Bliss-32 V4.0-74 
1818 OBSSPARTIAL_$¢ - Partial Escape Sequence 127388-1 982 #3336333 {COeRTL ne Scoaaccérr 642;2 
7 1$? ! PUT HERE or NEXT_CHAR. 
$ 128 a 
64 198 PH_PTR = .CHARS_READ + .TERM_SIZE ; 
14 NC“PTR = i ; 

64 4 '¢ 

644 ! Read one character at a time until the entire escape sequence has 

oF } been read. 

ees § : 

668 4 WHILE .END_OF_TERM EQL 0 DO 

res 5 BEGIN ! Begin loop 

651 ; FUNC_VAL_2 = TRMSM_TM_ESCAPE + TRMSM_TM_NOFILTR + TRMSM_TM_TRMNOECHO 

° ¢ $ + TRMSM_TA_NOECHO ; 

654 RAB = .COBSSAL_WRITE_RAB C .UNITCO) ] ; 

$36 COBSSRMS_GET (~.RAB,~.FUNC_VAL_2, 1, TERM_CHAR ) ; 

14 


ww 


Wr —OO@ 


AAAS 


: Deposit sequence character in appropriate buffer. 


IF .TERM_IN_NEXT EQL 0 


660 

66 

66 THEN 

66 BEGIN 

664 '¢ 

665 ! This is a workaround for an RMS bug that did not 

206 ! make it into the final code freeze for v4.0. 

66 ! The next three Lines can be pulled when the RMS fix 

O68 } is made. (see NEXT_CHAR below) 

670 IF .TERM_SIZE EQ. 1 ! Put first character 
671 ! of terminator seq 
oF PH C.PH_PTR = 1) = %x°1B" ; ! into PUT_HERE 

674 PH C.PH_PTR) = .TERM_CHAR ; ! Put character just 
675 PH_PTR = .PH_PTR #1; ! read in PUT_HERE 
67 TERM_IN_NEXT = 0 ; 

67 ND 

67 ELSE 

6 EGIN 


8 
'¢ 
! This is a workaround for an RMS bug that did not 
! make it into the final code freeze for v4.0. 

! The next three Lines can be pulled when the RMS fix 
is made. 

I 

T 


F TERM_SIZE EQL 1 
NEXT_CHAR CO] = &X"1B" ; 


NEXT_CHAR C.NC_PTR] = .TERM_CHAR ; Put character just 
NC_PTR = .NC_PTR + 1 ; i read in NEXT_CHAR 


Put first character 
of terminator seq 
into NEXT CHAR, 


EN 


Be Se Oe Se Be Se Be Se Se Se Ge Se Se Se Fe Se Ge Ge Ge FH Ge Se Ge FH Se Se Ge Se Fe Se Se Se SH Se Ge Se Ss Ss Se Se Ss Se FH Se Ge Oe Se Se Se Se Se Se Se Oe Se Oe oe 


Det et et et et ek et ee et de ee ee et eek ed et ek et et et et nt nt nt ot nt lt nt nt nt nt nt nt at et tt ele 


ee ee ee ee De ee ae ae ed ed 


SELESLESLESELSEALAN SS SSNVSARANIASSSISALARLS 


WWE ARERR ERR ERE EPAPER EE EEE EEE EEE PUI Oonorononononoruronuny 


FORtaCcePt 


es 
5 


| kek ak- deleted ek eke kee ae ae ek ek ek ek et bt et bt at be ae et a 


; 06 
; 0 

+3 
3; 2705 11 
3 le 
; 270 18 
3; 2708 14 
am i 
: 2711 i3 
3 ar 18 
: 271 19 
3: 27146 0 
at ) 
: a$ : 
: 2718 4 
: $738 se 
; ist $$ 


=A BEES EEE PALE EE 


pe 
“vw 
liens 
> 


58 


os 


| 
| 
| 


7 
VAX COBOL ACCEPT Statement 15-sep-1984 $3: 36:86 ot Bliss-32 V4.0-74 
-5EQ = Partial Escape Sequence 14-Sep-1984 12:10: COBRTL.SRCJCOBACCEPT .832;2 

TERM_SIZE = .TERM_SIZE + 1 ; ! Total Terminator size 

'¢ 

! Ugly = but it’s the only way to check for the end of an 

! escape sequence. ALl known KEY escape sequences end in 

‘ gne of these characters and none of these characters fall 

: n the middle of an escape sequence. This will have to be 

} updated if new escape sequences surface. 

IF ((.TERM_CHAR GEQ ZC‘°A* AND «TERM_CHAR LEQ 2C'°M') OR 
(,TERM_CHAR GEQ ZC°P' AND .TERM_CHAR LEQ %C°S') OR 
(.TERM_CHAR GEQ Bebe AND .TERM_CHAR LEQ Cty") OR 

THE ERMA CHAR EQL %xX'7E")) 

BEGIN 
END _OF _TERM =1; ! Signal completion 
! Have to get rid of a possible status RMS$_TNS, Terminator 
! Not Seen. Assume success we have reached this point. 
! It is not advisable to overwrite data in the RAB but there 
} is not way to avoid it in this case. 
RAB CRABSL_STS] = RMS$_SUC ; 
END ; 
END ; ! End sees 
END ; ! End COBSSPARTIAL_SEQ 
O7FC 00000 COBSSPARTIAL_SEQ: 
-WORB Save R2,R3,R4,R5,R6,R7,R8,R9,R10 
5E 04 C2 00008 SUBL2 #4, SP 
SA 04 0000 CLRL END_OF_TERM 
38 AC 00 00007 MOVL PARARETERS. R2 
5 24 —=C=«<iA 43 0008 MOVAB 36(R2), R 
53 A2d 00 OO000F MOVL 4( ° 
1¢ A2 6 C1 dt ADDL3 (R7), 28(R2), PH_PTR 
56 01 00 0001 MOVL 
54 08 AC 9A 00018 MOVZBL UNIT, R4 
A D3 Ooi 1$: Ist ND_OF_TERM 
59 5240 BF 3 00 MOVZWL #21056, FUNC_VAL 
55 0000000060044 D6 00 H VL COBSSAL URI TE RABERGI, RAB 
‘ DD 000 $ PUSHL SP 
DD 000 PUSHL 
0220 F BB 0 PUSHR #*M<R5 RID 
FOF3 cr 4 FB 000 CALLS #4, COBSSRMS_GET 
6€ 9A 000 MOVZBL TERM CHAR, RO 
30 =A » 4 TSTL 45(R2) 
1 4 BNEQ 
01 3 1) 4 CMPL (R7), #1 
5 is 0048 BNEQ 
FF A843 1B 9 OO4A MOVB #27, -1(PH_PTR)CPH) 


Page 72 
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7 

CCEPT OBSACCEPT = VAX COBOL ACCEPT Statement 18-5 <1 254: AX-11 Bliss-32 V4.0-74 p 73 

it th EOBSSPARTIAL SEO S Pert tol Escone Sequence Ve~$een138S $3:95:55 «eta lescag alter ’b82.0 090 44) 
: MOVE = RO,_: (PH_PTR)+CPH) | 3 41 

— 30 H be - CLRL ind) = ; $189 

10 11 BRB 5 ; 416 
01 } : 3$: cnt (a7), rT) ; 4192. 

gc A 8 MOVE #7, $282) t 6196 

C A2 f 48: move RO. ot (R2)CNC_PTRI : 419 

$: NC (R7) : 6 
. See ie ah. : $300 
4D «OF 1 Chea” H #77 ; 
t it 0¢ BLEQU 9S" : 
50 «BF 50 9 76 6% CHP RO, #80 + 4211) 
53 BF $4 at tS #83 : 

le 18 BLEQU 9S" : | 
6C «BF 9 7$: CMPBséRO, «#108 t 4212. 
: 1F BLSSU «8S : 
79 =s«BF 1 cme RO. #121 : | 
7E oF a 8 8$: cMPB RO, #126 t 4213 
5A 1 D 94 9S MOVLo#t] ND. F_TERM : 4 I 

08 AS 00010001 F MOVL #655 7, 8(RAB) i 49@ 
FF BRW 1 > 4154 | 
DOOA2 10% RET : 4227. 


; Routine Size: 163 bytes, Routine Base: _COBSCODE + OEDF 


C 


32 V4.0-74 
OBACCEPT .852;2 


ted 
CEPTed 
s hit 


z . 

CCEPT COBSACCEPT = VAX COBOL ACCEPT Stat t 18-5 “19 254: AX-11 Bliss- 
i868 COBSSDELETE_KEY = Delete Key processing 12-808-198e #3336333 ECOaRTL sre} 
3; 27 4 ZSBTTL ‘COBSSDELETE_KEY = Delete Key processing’ 

: 3783 ri ROUTINE COBSSDELETEKEY ( PARAMETERS © Ret veCfor 

; 7 4 UNIT : VECTOR C2,6vTE), 

; f tee FLAGS ) +: NOVALUE = 

3 4 ? : : : FUNCTIONAL DESCRIPTION: 

: f ? 5 : : Delete Key processing. 

: f $ ; FORMAL PARAMETERS: 

3 f ¢ : Z } : PARAMETERS.mlu.ra Contains data for this routine. 

3; 27 4261 1! UNIT. rbu.va orrey of two unsigned byte integers. 

3 a7 4242 1! The first byte is the unit number designating the 
3; e7 4245 1! device from which the otr ing is to be read. 

3; 27 4244 1! The second byte indicates whether the routine should 
3 Se ? $2 ; abort or return to the calling program. 

3 o : of ' FLAGS.rlu.v Screen enhancement flag. 

3 2766 4 rt 1 ! IMPLICIT INPUTS: 

3; 2745 4250 1! 

3; 276 4251 1! NONE 

3: 276 4 § 1! 

3 274 4 3 1 ! IMPLICIT OUTPUTS: 

3: 276 4254 1! 

3; 2750 4255 1! NONE 

3; 2751 4 2$ 1! 

3 e7 ¢ 4257 1 ! ROUTINE VALUE: 

3; 27 4 33 7! 

3: 2754 4259 1! 

3; 2755 4260 1 ! SIDE EFFECTS: 

; 736 4261 1! 

3; e7 4 6¢ 1! NONE 

3; 275 4265 1! 

3; 275 4264 1 !-- 

3; 2760 4265 BEGIN 

3; 2761 4 06 

3; 276 426 LOCAL 

: 276 4 : REF $RAB perl: 

3 2764 4 $ DELETE BUF : VECTOR BYTE), 

3 2765 4270 S$ Ok =: INITIAL (6), ' Characters not dele 
; 766 4271 REST_CEN, ' Length yet to be AC 
3; 276 4 ' after DELETE KEY wa 
3 res 427 REST_PTR ; ' Where to put rest o 
3 , H : ! chars on next $GET 
® + 

$2771 4 16 ! Delete Key processing. Delete one character at a time. Delete previous 

: 277 427 ! character typed by backspacing yt a space to delete (overwrite) 

3 46 ? i : coerce ter. ene backspacing again to put cursor in position to continue 

3 : ng data. 

3 2775 4280 ! Hitting Phe DELETE KEY terminated the previous $GET, therefore perform 

; ve ; 1 : another $GET to read the rest of the data expected. 

: 277 4 5 ! Bind PARAMETERS to other names. 

3; e277 4284 te 


| ? 
CCEPT OBSACCEPT = VAX COBOL ACCEPT Statement bese 1 754: AX-11 Bliss-32 V4.0-74 P 75 
bein OBSSOELETE_KEY - Delete Key processing 12-868-1 984 $3:36;33 ECOaRTL-SRe cogatcéer 642:2 998 12) 
5 
f 1 SBIND_PARAMETERS ; 
7 : } If ( .FLAGS AND V_NO_ECHO ) NEQ 0 
f ? HEN 
? i If characters were not echoed to terminal there is no need 
7 § : to move cursor. 
} iE 
5 DELETE_BuUF = NULL ; ' mull 
fed 38 DEL TE ~BUF = NULL ; 
64 ; pet TE BUF = NULL ; 
796 ELSE 
795 BEGIN 
re DELETE_BUF (0) = BS ; ! Backspace 
79 DELETE BUF C1] = BLANK ; ! Space 
798 DELETE BuF [2 Ss ! Backspace 
799 END H 
$01 WHILE .TERM_LOC EQL DEL_KEY DO 
one BEGIN ! Begin Delete Loop 
804 CHARS_READ = (.CHARS_READ - 1) ; ! Decr # of valid input chars 
805 CHARS_OK = .CHARS_READ ; ! Save for left border check 
$09 IF .CHARS_READ LSS 0 
808 THEN CHARS_READ = 0 ; 


'¢ 
Calculations for $GET 


REST_LEN = .ACC_SIZE = .CHARS_READ ; 
REST“PTR = .PUT-HERE CDSCSA_POINTER) + .CHARS_READ ; 


‘+ 
' Check for too many Goleses, do not delete more characters 


! then were input. Ring bell to signal attempt to go beyond 
left border. 


if .CHARS_OK LSS 0 
THEN 


RVVNMNNNA 2 3 2 SS oe 


RIPPING — tt ot ot Oo 


DONO VEU “OOOO usewn—o 


BEGIN 
ani ear ( RING_BELL, .FLAGS ) ; 


COBSSRMS_PUT_BUFFER ( DELETE_BUF (0), 3, .FLAGS ) ; 


'¢ 


4 
4 
4 
ELSE 
: $PUT to Delete one character. 
Continue to Read input 


bse WwnN— 


RAB = .COBSSAL_WRITE_RAB C .UNITCO) ) ; 


5 


L 


6 


PT = VAX COBOL ACCEPT Statement 15-seo-1984 $3: 36:68 AX-11 Bliss-32 V4. Poge oS 


0-74 
ETE_KEY = Delete Key processing 14-Sep-19 COBRTL.SRC COBAL CEPT B$2:2 
COBSSRMS_GET ( .RAB, .FUNC_VAL, .REST_LEN, .REST_PTR ) ; 


'¢ 
' Reset CHARS_READ - Upgete # of input chars read. 

! Reset TERM_SIZE and TERM_LOC - New terminator ( Note: this could 
: be the DELETE KEY again) 


—~—o 

oo 

of 
co 
oO 
nm 
wv 
— 


CHARS READ = .CHARS READ + .RAB CRABSW_RSZ) ; 
TERM_SIZE = .RAB (COBS$B_STV2_LEN] ; 
TERM_LOC = .RAB CCOBSSB_STVO_TERM]; ! Terminator Location. 


'e 
Check for partial sequence error 


SoEreornr enue 


If .RAB CRABSL_STS] EQL RMS$_PES 
COBSSPARTIAL_SEQ ( .PARAMETERS, .UNIT ) ; 
END ; ! End Delete Loop 


PAPA 


DONO US Ww — 


'¢ 
Did the latest SGET come across a terminator ? 
If so, set flag used by COBSSILLEGAL_TERM to signal that the terminator 
was encounter in this routine. 
if TEMA SIZE NEQ 0 OR .RAB CRABSL_STS] EQL RMS$_EOF 
TERM_FROM_DEL = 1 ; 
END ; ! End COBSSDELETE_KEY 


SUsereZes 


8 
9 
0 
1 
§ 
4 


Se Se Se Ge Se Se Se Ge Ge Se Se Se Fe Se Be Se Se Se Se Se Se Se Ge Se FH Ss os Ge Ge Se Se aes 
00.00 09 CD CD CD CD CD CD: 


& 
© 


O1FC 00000 COBSSSELE NE EE 


SE 4 €2 9000 SUBL2 #4 : 

8 04 0000 CLRL  CHARS_OK ; 465 
MAL SP EEtt tha Gateasteas: i 
07 Oc AC 0 i itd BBC 38° FLAGS, 1$ + 4288 
6E 84 0014 CLRW ©» DELETE_Buf + 4295 
02 =A 4 16 CLRB DELETE BUF +2 : 4297 
6— 2008 rf A) ool 18 movw #8200, DELETE BUF : O968 
02 AE 8 8S 09 5 MOVB *B DELETE BUFe? : 4303 

54 8 AC 9A 4 a3: MOVZBL UNIT > 4341 
0000007F &F a3 p} 0028 3$: cMPL 40(RS), #127 : 4306 
65 is 09 DECL (RS) t 4309 

58 63 00 0 MOVL  (R5), CHARS_OK > 431 

‘ 0037 BGEG 6 «4$ > 431 

65 04 00039 CLRL = (RS) > 431 


WrO 


7 
SACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 1S-se -1984 23:54: AX-11 Bliss-32 V4.0-74 Page 7 
itr) COBSSDELETE_KEY = Delete Key processing 14-Sep-19 4 3°} 6:35 COBRTL.SRCJCOBAC tépr.B92:2 ’ (12) 
57 18 Ad 3C 00038 4$: MOVZWL 24(R3) REST_LEN ; 4318. 
7 65 C F SUBL ¢ R5), REST_LEN : 
56 06 A3 ¢ ag ADDLS (R5); 4(R33, REST_PTR : 4319 
p 4 TSTL CHARS _ OK : 46326 
C 49 BGEG 4 : 
OC AC OD 048 PUSHL FLAGS : 4329) 
DD 0004 PUSHL @# : | 
FDD9 —sCF re 05 CALLS #2, COBSSRMS_PUT_BYTE : 
D 11 00 BRB 6 : 4326 
oc AC DD 0 3 oT 3 PUSHL FLAGS : 4335 
03 oD A PUSHL : | 
08 Af 9F 909¢ PUSHAB E Sur : 
FESC cf 0 FB F CALLS (be RMS_PUT BUFFER. : 
2 0000000060044 0 00064 68: MOVE Haak WRITE_RABCR4I, £4341, 
2$ DD 0006C PUSHL PTR 3 4342) 
DD 006 PUSHL REST LEN : 
20 3 DD 000 PUSHL 32 R3 ee 
52 DD 0007 PUSHL RAB : 
FD13 ct 04 FB 0007 CALLS #4, COBSSRMS_GET : | 
22 A2 3C OOO7A MOVZWL 34(RAB) + 4350 
6 50 £0 b007e ADDL2 RO, (RSS ; 
4 A OE A A 00081 MOVZBL 14(RAB), 36(R3) 3: 4351 
8 A OC A2 9A 00086 MOVZBL 12(RAB), 40(R3) : 4352 
000181C8 BF 08 A2 01 0088 CMPL (RAB), #98760 + 4358 
93 12 0009 BNEO & : 
08 AC DD 00095 PUSHL UNIT : 4360 
53 DD 00098 PUSHL R ; 
FEBE CF 02 FB OO09A CALLS a2. COBSSPARTIAL_SEQ : 
87 11 O009F BRB + 4306 
24 A3 05 OOOA1 7$: TSTL 6(R3) : 4370 
OA 12 OO00A4 BNEQ ; 
0001827A = BF 08 A2 01 900A6 CMPL 8(RAB), #98938 : 
04 12 OOOAE BNEQ : 
34 AB 01 pO 00080 8$: MOVL #1, 52(R3) : 4372 
04 000B4 9$: RET + 4374 


; Routine Size: 181 bytes, Routine Base: _COBSCODE + OF82 


7 
CORSACCEPT COBSACCEPT = VAX C 1 ACCEPT Statement 15-se0-1984 93:36:68 AX-11 Bliss-32 Ph tes Page 78 
18 COBSSILLEGAL_TERM = Illegal Terminator y 14-Sep-1984 12:10: COBRTL.SRCJCOBACCEPT .852;2 (13) 
; 2871 4575 1 ZSBITL ‘COBSSILLEGAL_TERM = Illegal Terminator’ 
5 i 4 6 1 ROUTINE COBSSILLEGAL_TERM ( PARAMETERS : REF VECTOR 
i 2873 43er | UNIT | : VECTOR C2,6YTEJ, 
3 75 4 8 1 KEY : REF SSTRSDESCRIPTOR ) : NOVALUE = 
; 578 4380 1 !+¢ 
; 44 : 3) : FUNCTIONAL DESCRIPTION: 
3 879 4 HY 1! Terminator from previous $GET was illegal - rin terminal bell to 
; 2880 4384 1! signal this. Perform another $GET of length 1 to look for another 
>; 2881 : 85 : terminator. Verify this new terminator. 
: Hy 4 M7 1 ! FORMAL PARAMETERS: 
3 2884 4388 1! 
; 2885 : 3 : PARAMETERS.mlu.ra Contains data for this routine. 
3 Hy 4391 1! UNIT. rbu.va errey of two unsigned byte integers. 
; 2888 4 96 2-2 The first byte is the unit number designating the 
3; 2889 4393 1! device from which the string is to be read. 
; 2890 4394 1! The second byte indicates whether the routine should 
3 14 rt 4 ' abort or return to the calling program. 
; Sor 6397 : FLAGS.rlu.v Screen enhancement flag. 
3; 2895 4399 1! KEY.wt.ds Destination of the receiving field of the control key. 
; 2896 4400 1! 
3: 2897 4401 1°! IMPLICIT INPUTS: 
; 2898 4402 1! 
3; 2899 4405 1! NONE 
5 4406 1! 
3: 2901 4405 1 ! IMPLICIT OUTPUTS: 
3 906 4406 1! 
3 4407 1! NONE 
3 4408 1! 
3 2905 4409 1 ! ROUTINE VALUE: 
3 4410 1! 
3: 2907 4411 1! 
3; 2908 zie 1 ! SIDE EFFECTS: 
: 2909 44135 1! 
: 2910 4414 1! NONE 
: 2911 4415 1! 
3 Be 4416 1 !-- 
3; 291 4417 BEGIN 
3 2916 rod LOCAL 
3; 2915 441 RAB : REF S$RAB_DECL, , 
3 BIg 4420 FUNC _VAL_2, ! Q10 Function Modifiers 
3: 291 mri} nO_B : INITIAL (0), ! 30 ping bell, =1 don't 
; 3918 44 é LOOK_FOR_TERM : INITIAL (0); i =1 buffer full, SGET 
: 291 442 ! only for a terminator 
3 2920 4424 REST_LEN, ' Length yet to be input 
3; 2921 4425 REST_PTR ; ! Where to put rest of 
3: 29 $ 44 $ ! input data 
3; 29 44 '¢ 
3 2926 4428 ! Bind PARAMETERS to other names. 
3 2925 4429 !e 
: 2926 4430 
3 2927 4431 SBIND_PARAMETERS ; 


COBSA 
COBSS 
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7 
= VAX COBOL ACCEPT Statement 15-Sep-1984 13:76:35 EebarteSnedcosatcéor 6$2;2 (13) 


T 
EGAL_TERM = Illegal Terminator 14-Sep-1984 COBRTL. 


+ 
Note : If CORSSOELETE KEY was called before this routine some 
special handling is ye 
It is possible a previous call to COBSSDELETE_KEY would have 
filled the input buffer without poeses across a terminator. 
When the input buffer is full = look for terminator only. 


It is also possible that COBSSDELETE_KEY came across a terminator, 
therefore it is gniy necessary to ia the terminator not 
perform another $GET. This is flagged by TERM_FROM_DEL = 1. 


ee 


'¢ 

: Ring bell to signal illegal terminator. 

! Don*t ring bell if gy the Delete key, or if the 
! terminator has come from COBSSDELETE_KEY (wait for 

} SVERIFY_TERMINATOR to check terminator). 

BEGIN 

le tte ( RING_BELL, .FLAGS ) ; 


! Reset - next time 
NO_BELL = 0 ; ! ring bell 


'¢ 
Is there still data yet to be input ? 


IF .TERM_FROM_DEL EQL 0 
BEGIN ! Begin TERM_FROM_DEL=0 
IF .ACC_SIZE GTR .CHARS_READ 
THEN 
BEGIN 


te 
: Calculations for $GET. 


REST_LEN = .ACC_SIZE = .CHARS_REA 
REST“PTR = 


'¢ 


a E D * 
-PUT“HERE COSCS$A_POINTER) + .CHARS_READ ; 


! NEVER do a Read of 0 length, this causes an infinite loop 
of bell ringing. 


if .REST_LEN EQL 0 THEN REST_LEN = 1; 


RAB = .COBSSAL_WRITE_RAB C .UNITCO) ) ; 
COBSSRMS_GET (~.RAB,~.FUNC_VAL, .REST_LEN, .REST_PTR ) ; 


'¢ 


CCE 
ILL 
WHILE .LEGAL EQL 0 DO 
N ! Begin Term Loop 

IF .NO_BELL EQL 0 AND .TERM_FROM_DEL EQL 0 ' NO BELL is set in 

THEN ! $VERIFY_TERMINATOR 
4 
4 
4 
3 
: 
4 
4 
4 
4 
; 
i Update CHARS_READ, TERM_SIZE and TERM_LOC. 


2 eee — 


$GET Xpurtere filled but illegal terminator, therefore 
we are looking only for a terminator. 


heed 
COBSACCEPT = VAX COBOL ACCEPT Statement Sep 4 23:54: AX-11 Bliss-32 V Page 80 
COBSSILLEGAL_TERM = Illegal Terminator 1228 Sep 71386 $3 710: 35 COBRTL.SR Reic cOBACC PT B82; 2 . 195 
4489 '- 
4490 
4491 CHARS_READ = .CHARS_READ . :Ras CRABSW_ RSZJ) ; 
449 TERM_SIZE = .RAB CCOBSSB LEN] ; 
ree ty TERM_ Loc = .RAB COBS$B_ Sty “TERM; 
4495 END ; 
449 
449 '¢ 
994 4498 ' $GET buffer filled but no toratagter seen - TERM_SIZE = 0 
5 499 ' Do 1 character reads until you hit a terminator that 
238 280 ' you can then gttengt o verify. 
99 1 : lso ere an End o le “Z here and do not perform 
8 ! onerher i “SVERIEY TERMINATOR will take care of the “2. 
444 } gh00 M EQL 1 Case => came into this routine with 
001 ' 
B36 le 
00 
004 IF .ACC_SIZE atte tenes, READ 
005 THEN LOOK_F 
006 WHILE (. TERM slit” EQL 0° AND ie CRABSL_ STS] NEQ RMS$_EOF) 
94 OR (.COOK_FOR_TERM EQL 1 
009 BEGIN ! Begin 1 char $GET 
REST_PTR = .PUT_HERE CDSCSA_POINTER] + .CHARS_READ ; 


FUNC_VAL_2 = TRMSM_TM -ESCAPE + TRMSM_TM_NOFILTR 
TRMSM_TM ST RMNOE CHO” + TRMSM_TM_NOECHO ; 


RAB = .COBSSAL_WRITE_RAB C .UNITCO) J ; 
COBSSRMS GET (~.RAB, .FUNC _VAL 2. 1, .REST_PTR ) ; 


'¢ 

! Set TERM_SIZE and TERM_IN_NEXT before possible 
' call to COBSSPARTIAL_SEQ. 

! If user attempts to oo data other than a 

' terminator - error. 


IF .RAB CRABSW_RSZ] NEQ 0 
THEN 


bleh cdidh eh dich dh ehh ch ech ech ech hah dl 


SOSSSSSSS4S3S3Ssss 


SSSSSSSSSS 
VMFUN —OOONOUSWNO 


WAWIIws 


ooooo 


oo 


WWAWAA AAW AAA 
BIFAFUS—SS 


PIPIPOPININPININPIDS 2 OP? OO? OO oO 
no 


BEGIN 
TeRR-size = 0"; ( RING BELL, .FLAGS ) ; ! Error. 


ELSES” ! Terminator seen. 
A CRABSL_STS] EQL RMSS$_EOF 


mores wr fonteot P is typed in as the $6 
sages to a $ ‘3 not recorded in 

R COBs$a of v2. CEN therefore, pull out 
Loop, and let SvE airy TERMINATOR Sodle the ty, 
but 2ou, ye oad the “2 in 

RAB (costs LEN] as this is where 
SVERIFY TERMINATOR looks for it. 


oo 
w 
PUPP PVP PV SULIT SVSU BD DS SUVS SULIT STII BB OE EEE EEE EPPS EP 


Poe oy oY oY oF oY ot ot ot ot ot ot ot ot et et ek ek ek ek ek ek ek ek ek ek ek ek ek ek ek ek ee 


BPE FAWN 
MEW —OOONOUS WN 
a: 


FR 
-—OoO 


WN —OOONO 


| el ek ek ee el ek ek el ak 


ARANASSSISAFERIS SEVERE 


=O ANA BBB BPP PEP NOAOANAAOAOOU 


~_N 
NO 


| el ela lla Til Den hah Sel ek ek Dek ek Dele ek Jk Sek ek ek Sek ak J Sek 


Ab Ab Adhd dh db bh hh dh ah bh sh ah eh 4h ah A) 


R=S Se 


tty he CEPT = VAx C ACCEPT Statement 
OBSSILLEGAL_TERM = illegal Terminator 


1Seseo-9ne 25:54:32 


AX-11 Bliss-32 Ph tes 
COBRTL.SRC coaat CEPT.852;2 


BEGIN 
RM_SI7ZE = 1; 
RAB reoatsa STVO TERM] 22; 
LOOK FOR TERR 20; ! Set to get out of loop 
ELSE 
BEGIN 
00x £08 TERM = 0 ; ! Set to get out of loop 
ERM-SIZE = .RAB Copsse_stv2_ LEN] ; 
TERM-LOC = .RAB CCOBSSB-STVO-TERM) ; 
END ; 5 ! End 1 char $GET 


'¢ 

_Check for partial sequence error 

i " e CRABSL_STS] EQL RMS$_PES 

COBSSPARTIAL_SEQ ( .PARAMETERS, .UNIT ) ; 

END ; ! End TERM_FROM_DEL=0 
'¢ 
! Now have a Terminator in PUT_HERE. Reset flags. Call 
! macro to verify Terminator. 


Hh Sa PTR = ,PUT “oO: COSCSA_POINTER] + .CHARS_READ ; 


TERM “FROM_DEL 
MIN ONEXT. = “9 
SVERTHY TERMINATOR ; : 
END ; ! End Term Loop 
END ; ! End COBSSILLEGAL_TERM 
OFFC 00000 COBSSILLEGAL_TERM: 
.WORD Save R2,R3.R4,R5,R6,.R7,RB.R9,R10,R11 
5E 94 ce 000 SUBL 
0 CLRO LOOK FOR TERM 
2 06 =A 0 MOVL PARARETERS, 
: =: & 0 MOVAB = 28(R 
<4 A2 9 OO00F MOVAB 36(R ; 
? 8 A 13 MOVAB 56(R2), R 
6 ? 17 18 TSTL (R?) 
1 19 BEQL 
04 00018 RET 
58 : 1C 28: TSTL NO_BELL 
1 1 BNEQ 
34 A p g TSTL (R2) 
0c BNEQ 


29 18) 


4376 


4417. 
4425 


4445 | 


4447 


eee: 
| FoReccert 


COBSACCEPT = VAx C 


FDGA 

18 = A2 
58 04 
FC68 
28 

18 = A2 
0001827A 
58 04 


FC16 


FCA8 


0001827A 


0c 


ACCEPT Statement 
COBSSILLEGAL_TERM = Illegal Terminator 


CF 


01 


CF 


oc : 

344 C«A 

0 

mee 

wf 
neon 
34 

04 

22. AS 

‘ 

—E A 

 f 

s 

08 AC 

i 

08 As 

iH 

53 

ee 5240 oF 
85 ooo0d800co044 
08 AE 

22. = AS 

OE 

oc A 
SA 
A 

08 


8F 


A 


FPOMWMN— OWNS "(Wn F Doo 


SEDEELE GEECOOSS 


SSSSFRSSULAS 


6$: 


oooooo 
Sooooooooo 


Nx 
NS 


Sesesssseecees 
REXSSSssseeesd 


SSSSSSssssssssssssss 


oOoooeo 
SOOoOOCOCoCoOoOoOoOooSooS 
ManoOIVIVIIOMOAOAoOoO 
Pe MNIVMS OO 


12$: 


fe seont9ge 35:84:32 


ai hy 


FLAGS 
#2, COBSSRMS_PUT_BYTE 


io 

15$ 
#0, #16, 24(R2), 
2), REST_LEN 
; hes T_LEN 
; “hes. REST_PTR 


(R6) 


= 


PTR 
“TEN 
) 


(R6) 


AB), #98938 
-FOR_TERM, #1 
4(R2), REST_PTR 


=m 
mn 


FUNC_VAL_2 


#4, COBSSRMS_GET 
Hl 


wis 
#2, COBSSRMS_PUT_BYTE 
(R5) 


9$ 
OOK _FOR_ TERM 
is #98938 


126, PS CRAB) 


AX-11 Blisg-32 V4. 
COBRTL.SRCICOBACCE 


AL unite -RABCRO], RAB 


é 
36 WRITE. VA‘atR«), RAB 
*PTR 


epi. 3 2:2 


a 


-—e— 


tCoar 


be 12:10:88 


<1 
=I 


18-5 
14-Se 


A 
SILLEGAL_TERM - Thueget Terminator 


COBSACCEPT = VAX COBOL ACCEPT Statement 
Coss 


“Piercy 


wmnmnwwmn ow ww rw 
wsiwvwvwwvw 4 ww ww 
Se ek ed el ed i le ee ek Be ek ed ee ee eh ee ee eh ee ee LL LLL EL Lea LL LT ee ee 
oa > 
wen > ws 
wm w ~ 4 
x at a 6 t 
—~ i — ] ~ yY 
— av vy _~ ~ w Se t oO oO 
u OS “wT ~N o - o w 2 a a 
-~& oO _ a =< ws nm ~w << -_ _— 
wwe awe ~~ ~ 4 o w 2 , 4 
co @® <- SS hae 4 -~ ww oo . a) o o 
~w = am a 4 a 6. oo w Vv Vv Vv 
AX “ Aw = 09 oe Fe cal 
ss. @a~~Sr ll ss 7 ~ ~~ *8@ « ry res faz 
nn . =< = AA ma oOo -~ O Ww ' 2 t So © 2 ar 
2 w vs <= 8S cz z= 2 _ {ee 2 “ww w& i) NUNN 
ca w oon ca _/'- _ ~ WJ be ol’ 4 nan 
-—~ sce “OoN-NRA ~~ PR >IT RA HF He +s MO*CH-—-— a 8s SOM rNw~ + + wer 
) bh (ONE OO DCI OR We Neen Se ere N wwe TMOeK-MmMaeace 
OO ODE ae Te Rr RR ER SE MVONE K SVNOTRBaV~VOVaucexr de MVM a ecanvewve 
Pe) = 2 | 
@o@ aur) @ aM awIM IY jan | 
ws = YOTT 1190 IJ9O4aNOYIO90440 OwI@0C9CGTsyy 49040 FIEsrtrIw soTIrrweow soy 
Pooes 25540 18 SOOs WE 2OWOE EWE SO DZ ORO SE SO Od OO <z ww Soo x OR ew 
wMu lad 
DEO HAa Of COSES ODOHSS OS DODDS AOL OS Goo eaa sacs waaaoee secre 
ete ee a eh Kod Cs a a fof Af 
~~" wT wo oO ~ @ o Oo - Nu Mm 
- - - - - - _— N Nu NM ON 
Oct uswwm Our +. OANE VOMrINOD = <ZVONODOON-TO <«uwwe wr ee) 
2OOCOC IOS EL EE GE GT GE GE GE 
2 DOCOOCOOOOCOOCOCOC? POO OCOSOOOSOOOSOOOOSOOSCOSOOOOOOOOOOOOOOOOOOOOOOoOO 
POPC OCOCCOODOCOOOCCOCOCOOSOCCOOOCOCS OOOCCOOCOCOCOOCOOOOOOOO OOOO OOOOOO 


ede VOOOe Ve w Fa 8 oe SOO MV WO OOMOOOrmMobu @Ooevwve-- wv 
KOO O- COOue Vr OM Oe Or O- On On Or O4 Or Or Om WOOL COU 0CO— OOO u WO OOMO 


Wn ana DIM HK Ne OVID FTF KN VOM — FS OMM BOON OON BR OMTUMO” TRO 
4440 404004 0M << LMOMO CZ ODMMNUNN ZNOOW OWE OCOaQnodcato eo Store se~ 
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oct @ wet OF -@moc9§cewd@®@d+.- ®& - ww ao <« v Yv ooo 
ao @ ~] w 4 2 al = 
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fee 


- 


FossaccePt 


3; Routine 


CO8s8 


CEPT = 
LLEGAL. 


Size: 415 bytes, 


ERM TLL 


ACC 
ega 


ig 


Routine Base: 


5 
fst. “1 
14=Sep-1 


T Ste tement 
Terni nator 


-COBSCODE + 1037 


Be 13:70:88 


AX-11 a? 
COBRTL.S 


R 


nsec -32 


4,0-74 
tcéePr. 8 


§2;2 


at 


ws 


‘+ 
Bind PARAMETERS to other names. 


SBIND_PARAMETERS ; 


'¢ 

' Position cursor after FIELD of POTECTED Read. 

! This code is necessary if the # of characters input is less than 
the # of characters expected. Move cursor the difference of the 


1 

! two numbers. 

: 4 DEFAULT has been used move cursor the whole length of the expected 
size. 

' 


—ODOOWOUEWR OC 0One 


WAAR ROPOROPONUPUNONONY 


SAFRAN 


8 

SACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 15-50 -1984 2546: AX-11 Bliss-32 V4.0-74 Pa 5 
ee EOBSSELEAN. UP = Clean up for VAX COBOL 12-80-13 43:75:55 COBRTL. neicosatcéor 6$2:2 0 8 
3 4583 1 XSBTTL "COBSSCLEAN_UP = Clean for VAX COBOL’ 
4584 1 ROUTINE COBSSCLEAN-UP PARAMETERS : REF VECTOR, 
: 4586 ) ": NOVALUE = 
3 4 1 tee 
; : 3 : FUNCTIONAL DESCRIPTION: 
: 4 7 Perform clean up before returning control to VAX COBOL. 
3 4591 1! Position cursor after FIELD of POTECTED ACCEPT, S$PUT to turn 
; : 35 ! attributes off, and determine if ADVANCING is needed. 
; is | FORMAL PARAMETERS: 
3 2239 } PARAMETERS.mlu.ra Contains data for this routine. 
3 095 4398 1 FLAGS. rlu.v Screen enhancement flag. 
: O99 4600 1 | IMPLICIT INPUTS: 
: 3098 4601 1! 
‘fe hl) wm 
> 3101 4604 1! IMPLICIT OUTPUTS: 
3 4 4605 1! 
S 3104 tgor i — 
> 3105 4608 1 | ROUTINE VALUE: 
: 3109 te10 yi 
> 3108 4611 1 | SIDE EFFECTS: 
3 09 461 1! 
3 ? ree : } NONE 
; ‘ 4 "BEGIN 
3 4 LOCAL 
: $ RAB : REF $RAB_DECL ; 


ee ee a a ed od od od od 8 wd wd 


SEPP LL ELLE EPP PLP PELE EE EES 
PAA AAAAAAAAAAAAAAAAAAAAaAO 


MOVE_CURSOR : INITIAL (0), : ton ag 
MOVE_NUM ; ! # of positions to 


[————- screen nlaceanlanh adie 


8 

PT SAC Any COBOL ACCEPT Statement if.se =1984 : AX-11 Bliss-32 V 
popsacce att EC EAN - Clean up for VAX COBOL 14-Sep-19 4 ( 36:88 COBRTL.SRCJCOBAC 
; 3137 4 ! move cursor 
; 138 rhe ei IF .YES_DEFAULT NEQ 0 
: $126 tee§ z THEN G1 
: 3141 4644 4 MOVE _N ACES SIZE ; ! DEFAULT used 
; 106 agg : MOVE- “CORSOR 
: s 
; 128 t6c8 3 * er -CHARS_READ LSS .ACC_SIZE ! # of chars input is 
: 168 re i THEN BEGIN ! less than expected 
: 148 4651 4 OVE NUM = .ACC_SIZE = .CHARS_READ ; 
3; 314 4656 4 ONE ~CU RSOR = 1; 
: 133 tess 
: 31 é 4655 IF cae i NEQ 0 
3 2 $828 THEN 
: 38 tese See OCAL 
; 136 4659 4 SPACE_BUF : VECTOR [200,8YTE) ; 
; é HSFILL ( BLANK, .MOVE_NUM, SPACE BUF [0] ) ; ! # of spaces to move 
: 139 ise 4 COBSSRMS POT BUFFER « SPACE_BUF [OJ], .MOVE_NUM, .FLAGS ) ; ! cursor 
; 3160 466 3 END ; 
3; 3161 4664 END ; 
3163 tee 1 
: 3164 466 i $PUT to turn attributes off. 
; 3165 4668 i If no attributes were turned on, there is no need to turn them off. 
3; 3166 4669 ! OFF_BUF holds escape sequence to turn attributes off. OFF_LEN holds 
3; 3167 4670 ! the length of that sequence. 
fa 30 an be * 
; 170 4675 IF .PUT_FLAG NEQ 0 
: v6 4675 COBSSRMS_PUT_BUFFER ( OFF_BUF [OJ], .OFF_LEN, .FLAGS ) ; 
Me BBR 
: 3175 467 i Determine if ADVANCING is requested. 
; 3176 467 ! If bit 10 = 4 advancing. If bit 10 = 1 no oggencing, 
: 3177 4680 ! Set igessaa.f EVO] - Seas" depending on bit 10, to flag to next COBOL 
; 3178 4681 ! statement hor. advancing/no advancing is required following this 
3; 3179 rhe) ! ACCEPT statement. 
Fede Se fe 
: 188 seh IF _(.FLAGS AND V_ADV) NEQ 0 
> 3184 468 COBS$AB_PREVLO] = ACC_DNA ! Signal Do Not Advance 
3 ; 5 ree ELSE 
; HH ret ‘ Echo carriage return to screen if advancing is called for. 
: 3189 469 BEGIN 
: 31 469 COBSSRMS PUT BYTE ( CARR RET, .FLAGS ) ; 
3 194 4694 ol PRevEOl = ACC_A AD? ; ! Signal ADVance 
: 198 1698 END ; ! End of COBS$CLEAN_UP 


cc! ——_—_- - 


épr. 7382; :2 


Page 86 
. (14) 


8 
CCEPT coesace PT = VAX COBOL ACCEPT Statement 15-5 “1 AX-11 Blisg-32 V4.0-7 P 7? 
(9848 OBSSCLEAN UP = Clean up for VAX COBOL 1a=8e6-1984 13: 16: 33 COBRTL. tT COBACCEPT.B 2:2 ad ty 


O1FC 00000 COBSSCLEAN_UP: 


. WORD Say R2, RS, Rs, RS,R6,R7,RB + 4584 
8 000000006 90 HOVAB COBSSAB PR "RB" : 
cE MOVAB : 
04 AC D MOVL a Pre t 4617) 
C As E BLBC 60(R6) + 4634) 
50 04 CLRL = MOV + 4636) 
40 AB D TSTL oaths) + 6641 | 
06 1 BEQ $ : | 
57 18 As 3¢ MOVZWL 4 (R6), MOVE _NUM 3 4644, 
1 BRB $ + 4645 
1c 6 18 Ab 10 90 FD CMP ZV 40. #16, 24(R6), 28(R6) ; 4648 
? 18 AB 3 MOVZWL sng MOVE_NUM + 4651 
? 1c (6 OC SUBL2 28(R £ NUM : 
0 9} D MOVL MOVE _CURSOR 3 4652. 
9 D TSTL nove _CURSOR + 4655 | 
131 BEQL © 4$ : 
57 20 6€ 00 2c MOVCS #0, (SP), #32, MOVE_NUM, SPACE_BUF ; 4661) 
08 AC oD PUSHL FLAGS + 4662. 
57 0D PUSHL HOVE ; 
08 AE OF PUSHAB ACE BU ; 
FCIE CF 03 F CALLS a3. COBSSAnS _PUT_BUFFER 3 
44 Ab D TSTL B(R6 + 4673 
OE 1 BEQL 3 
8 AC dD PUSHL : 4675. 
4 Ab DD PUSHL Bene) : 
48 ag F PUSHAB g (Rb : 
FOB CF Fe CALLS # COBSSRMS PUT_BUFFER : 
04 AC A gl BBC #10, $ ; 4685 | 
68 5 90 nove 5. COBSSAG _PREV ; 4687 | 
Py | 
08 ac OD PUSHL FLAGS : 4693 | 
7E D4 CLRL SP) 3 
FB66 CF 02 F CALLS ie. COBSSRMS put _BYTE : 
rs.) 06 9 MOVB 4; COBSS$AB_PRE > 4694 | 
04 RET > 4696 | 


; Routine Size: 120 bytes, Routine Base: _COBSCODE + 11D6 


COBSSR 
97 


_CLEAN_UP = Clean up for VAX RPG 14-Sep-1 


ZSBTTL "COBSSRPG_CLEAN_UP = Clean up for VAX RPG’ 
ROUTINE COBSSRPG_CLEAN_UP ( FLAGS ) : WNOVALUE = 


1 
} 
i FUNCTIONAL DESCRIPTION: 
Perform clean up before returning control to VAX RPG. 
FORMAL PARAMETERS: 


SES 
ae 
SRENLSSS 


wn 


i 

' 

i 

' 

FLAGS.rlu.v Screen enhancement flag. 
i IMPLICIT INPUTS: 

i NONE 

‘ 

: IMPLICIT OUTPUTS: 
i 

' 

i 

' 

i 

i 

! 

; 


uw 


NONE 
ROUTINE VALUE: 


i i 


a ts a 


SIDE CFFECTS: 
NONE 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
BEGIN 
'¢ 
: Peteratne if ADVANCING is requeste 

If bit 1 


d. 
: = 0 advancing. If bit 10 = 1 no agyenc ing, 
! Set COBSSAB_PREVLO)] - also depending on bit 10, to flag to next COBOL 
! statement that advancing/no advancing is required following this 
ACCEPT statement. 


FUN $0 OONOUN EWN "OOOVNOUS WO 


BIG oS ber adres 


if (.FLAGS AND V_ADV) NEQ 0 


5 og a EOD = ACC_DNA ! Signal Do Not Advance 


Sauenruuoobe 
MEAN —OOONOVE WN" OOOtNOuvfwun—o 


ba idan dada diadtadndtndtn din dada dada dade dete thie te ek eh et ek ek et et dak et ek ek et et et et nt 


SQN NNN SSS 


: BEGIN 
3 re Echo carriage return to screen if advancing is called for. 
40 4¢ COBSSRMS_PUT BYTE ( CARRORET, FLAGS ) ; 
41 4 COBS$AB_PREVEO) = ACC_AD? ; ! Signal ADVance 
4 oree END; 


ee 
x= 
oe 
~~ 
ae 
o 


Se Oe Se Se Se Se Fe Be Oe Se Se Ge Fe Se Ge Ss Se Se Ge Fee Ge Ge Ge Ge Se Se Se Ss Se Ge Se Se Se Se Se Se Ge Se Ge Se Ge Se Ge Se Ge Se Ge Ge Ge 


END ; ! End of COBSSRPG_CLEAN_UP 


0004 00000 COBSSRPG_CLEAN_UP: 
«WORD = Save R2 


£ acters coesacceel = VAX C ACCEPT Statement 1}-seo-1984 $3: 36:68 Cteatee tar cobatcetr 


ogf 


: 4698 


} 
CCEPT OBSACCEPT = VAX C ACCEPT Statement 14 -Sep-1 AX-11 Bliss-32 V Pp 9 
eit ee tty4 _CLEAN_UP = Clean up for VAX RPG 14- at 7 $3: 36; 8 COBRTL.SRC cosate Sars oe :2 age 48 
52 000000006 H: MOVAB C SAB, PREV : 
04 6 A BBC ihe, LAGs {3° t 47 
4 5 MOVB 5, * cobs AB_PREV : 47 
04 00010 RET 8 
04 AC DD 00011 1$: PUSHL ruass 3 4742 
43 D4 14 CLAL : 
FBG? sCF if 16 CALLS ae. PCOBSSRMS put _BYTE : 
62 4 018 MOV > COBS$SAB_PRE + 4743 
04 OO01E RET + 4746 


; Routine Size: 31 bytes, Routine Base: _COBSCODE + 124E 


8 
C CCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 1S-se -1984 23:54: AX-11 Bliss-32 V4.0-74 Pa 90 
et) COBSSFORMAT_FOUR = Format Four 12-8081 980 $3:75:55 COBRTL. REICOBACCEPT. $2:2 9° 16) 
3 re 4747 1 ZSBITL "COBSSFORMAT_FOUR = Format Four’ 
3 r ote ! ROUTINE COBSSFORMAT_FOUR ( og : VECTOR C2,BYTEI, 
; rk 47 1 : REF SSTRSDESCRIPTOR 
3 47 1 2 
; 47 1 
3 47 1 !e¢ 
3 ? rt 4 2 } } FUNCTIONAL DESCRIPTION: 
3 5 47 $ 1! This routine handles VAX COBOL ACCEPT Statement FORMAT FOUR, 
5 $f } } Control Key. 
3 : 47539 : FORMAL PARAMETERS: 
3; 3260 4761 1! UNIT. rbu.va orres of two unsigned byte integers. 
: 3261 4762 1! The first byte is the unit number designating the 
3 o¢ 4765 1! device from which the string is to be read. 
; 326 4764 1! The second byte indicates whether the routine should 
3; 3264 4765 1! abort or return to the calling ere ram. 
3; 3265 44 «| 1! Byte 2 = 0 = routine will abort on control z 
3 28 4767 1! and repronpt on conversion errors. 
3; 326 4768 1! = 1 = ( AT END ) 
; 3268 4769 1! routine will return to calling program 
3 44 4770 1! on control z and reprompt on conversion 
: 0 4771 1! errors. 
3; 3271 4772 1! = 2 = ( ON EXCEPTION ) 
: % 4775 1! routine will return to calling program 
3 Le oie ; } on control z and conversion errors. 
: Le 4776 ; } FLAGS.rlu.v Screen enhancement flag; 
: AA $778 : H KEY.wt.ds Destination of the receiving field of the control key. 
3; 3279 4780 1! IMPLICIT INPUTS: 
; 3280 4781 1! 
3; 3281 44 77% NONE 
3 ag 4785 1! 
; 328 4784 1 ! IMPLICIT OUTPUTS: 
; 3284 4785 1! 
3; 3285 o786 1! NONE 
3 My] 4787 1! 
3 hs | 1 ! ROUTINE VALUE: 
; 3288 4789 1! 
3 34 4790 1! 
3 4791 1°! SIDE EFFECTS: 
3; 3291 4792 1! 
: 4 47935 1! NONE 
: 329 4794 1! 
3 3294 4795 1 !-- 
3; 3295 oone 1 
; 38 479 BEGIN 
3; 329 ore 
3; 3298 47 LOCAL 
3 £380 : REF SRAB_DECL, 
3 4801 FUNC_VAL, ! Read Q10 Function Modifiers 
3 3301 $306 ! used in item List by RMS 
3 2 480 TERM_PTR, ! Pointer to terminator in buffer 


8 
T = VAX COBOL ACCEPT Statement 18-Sep-1986 23:54: AX-11 Bliss-32 v4.0-76 Page 91 
ORMAT_FOUR = Format Four 1o-gepn 188s 73:40:55 Peden sdescasalcelr e8e-0 096 16) 


NEXT CHAR : VECTOR C10,BYTE), : Gul tec © hold terminator sequence 
EGAC : INITIAL (0S, i = 0 if illegal terminator hit 
MASK : VECTOR C2) ; ! Longform terminator mask 


£ SACCEPY 


uw 


Oo 


Terminator mask = EVERY key is treated as a terminator. Each key pressed 
is gheckee for validity as a terminator. 

Valid terminators are err iege Return, Tab, Control Z, Arrow keys, 

PF keys, and the PROFESSIONAL Editing and top Row Function keys. 


TMASK fo = 32; 
TMASK = UPLIT (-1, <1, <1, <1, <1, <1, <1, <1); 


BPEL PPLE OO 


! Ring the terminal bell if user requests. 


If FLAGS AND V_BELL ) NEQ 0 
COBSSRMS_PUT_BYTE ( RING_BELL, .FLAGS ) ; 


' 
! Determine FUNC_VAL = Q10 Function Modifiers used by RMS $GET Service. 

! Set TRMSM_TM_NOECHO to syperess echoing of input characters to the terminal. 
! Set TRMSM TM_ESCAPE to allow Escape sequences to act as terminators (Arrow 

! keys and PF Keys and the Professional editing and top row function keys). 
Set TRMSM_TM_ A vie to allow this routine to handle the DELETE KEY. (not a 
] 

i] 

' 


Foy of of af at of af at ot ot ot ot 


IAW RIPIRININIPININUN 2 SS OOO 
WN — 9 ODONOUSWN "ODO VNOUSwn O00 
: 


ARI PORITURIRIPURINUIRD <2 8 ot 2 ot ot 


valid terminator). 
Set TRMSM_TM TRMNOECHO to suppress echoing of the termination character 
(COBS$SAB_PREV handles advancing / no advancing). 


WN — SO OBVNOVUES WN“ OOONOUS wo 


SEG 


FUNC_VAL = TRMSM_TM_ESCAPE + TRMSM_TM_NOFILTR + TRMSM_TM_TRMNOECHO 
+ TRMSM~TM“NOECHO ; 


! Item list for $GET 


AAA 
pot ey ee tps 


33 


SITMLST_INIT (ITMLST = XAB_ITMLST 
CITMCOD = TRMS_MODIFIERS, 


vuvvuvU 


PEER R REE EERE ERPS 


Be Be Se Se Be Se Oe Fe Se Se Se Se Fe Se Ge Se Ge Se Ss Ge FF Se Se FH FS Ss Se SF Ss Se Ge Se Ge SH Se Ss Se Se Se Se Se Se Ge Ge Ge Se Se oe Os Se Ge Oe Se Sete ee ee 


8 
5 0 
at 
= 
39 nk BUFADR = .FUNC_VAL), 
B44 (ITMCOD = TRMS_TERM, 
4 845 BUFSIZ = 32, ! 32 bytes in TMASK 
5 Bcf se BUFADR = .TMASK(1)) ) ; 
5 48 i RMS $GET - expect only terminators. NOTE: This $GET call is not the 
8 9 ! same as the call in routine COBSSRMS_GET. 
4 ogi 
51 26 WHILE .LEGAL EQL 0 DO ; 
2g 37 BEGIN ! Begin Loop 
az 3¢ RAB = .COBSSAL WRITE RAB C.UNITCO)) ; 
55 36 RAB [RAB$W_USZJ = 107; 
36 5 RAB CRABSL~ = NEXT_CHAR ; 
5 28 RAB [RABS$SV_ETO) = 1 ; 
58 5 RAB CRABSL"XAB) = XABTRM ; 
59 0 WHILE $GET~(RAB = .RAB) EQL RMS$_RSA DO SWAIT (RAB = .RAB) ; 


————————_—- 


a 8 
CEPT = VAX COBOL ACCEPT Statement 15-Sep-1984 23:54: AX-11 Bliss-32 v4.0- 
14 : St ; aT HS Re} 


Pa 3 
ORMAT_FOUR = Format Four -Sep-19 COBRTL. 9185 


74 
COBACCEPT .852;2 (16) 
IF NOT .RAB CRABSL_STS) 
THEN 


‘¢ 
! These are special case status that will be handled Later. 
(See note below for explanation of missing RMS$_TNS) 


if (.RAB CRABSL_STS] NEQ RMS$_BES AND 
RAB CRABSL_STS] NEQ RMS$_EOF AND 
RAB [CRABSL-STS] NEQ RMS$-PES AND 

NEQ RMS$-RTB ) 


4 

d 

4 -RAB CRABSL-STS 

LIBSSTOP (COBS_ERRDURACC, 1, .RAB + RABSC_BLN, .RAB CRABSL_STS], 
-RAB CRABSL_STV] J ; 

4 

4 

4 

4 

4 

4 

4 

5 

5 

5 

4 

4 

4 

5 

4 

4 

4 

| 


NOTE: No need for call to COBSSPARTIAL_SEQ as buffer of 10 bytes 
is more than sufficient to hold complete escape sequences. 
Status terminator not seen, would signal a need to 


' 
1 
! ' 
: Most | Secepe sequences are between 1-4 bytes long. 
: MS$_TNS 
: call routine COBSSPARTIAL_SEQ. 


TERM_PTR = NEXT_CHARCO] ; 


; 338 1+ 

3 44 Check for legal terminator, then copy it to KEY. 

; 3386 

3; 3387 If .RAB CCOBS$B_STV2_LEN] EQ. 1 ! Terminator is one byte 
; 3388 THEN 

3; 3389 BEGIN 

3; 3390 TERM_PTR = RAB CCOBS$B_STVO_TERM] ; 

3 Hd SELECTONE -RAB CCOBS$B_STVO_TERM) OF 

3 398 C CR, ! Carriage Return 
3; 3394 TAB ) : ' Tab 

3; 3395 

; 3396 BEGIN 

3; 3397 CHSMOVE ( 1, .TERM_PTR, .KEY CDSCSA_POINTER] ) ; 
3; 3398 LEGAL = 1; 

3: 3399 END ; 

: 3400 

: 3401 COTHERWISE) : ! Error = key not a 
: 0g ! terminator 

; 87 BEGIN 

: COBSSRMS_PUT_BYTE ( RING_BELL, .FLAGS ) ; 

; 3405 LEGAL = 0 ; 

; oF TES ; 

3; 3408 END 

3; 3409 

: 3410 ELSE 

3 11 IF .RAB CRABSL_STS] EQL RMS$_EOF 

3 ai6 THEN | 

; ++ 

3: 3414 ! CONTROL Z = the status RMS$_EOF is returned 

3; 3415 ! from the $Get Service. “2 iS not stored in 

: 3416 i RABCRABS_STVO_TERM). 


isi 


a 
> 


= 
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39 


se 
DAMMAM 


o 
SSSRNS ASU 
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COBSACCEPT = VAX COBOL ACCEPT Statement 18.5 -1984 23:54: AX-11 ss-32 V4.0 
COBSSFORMAT_FOUR = Format Four 12-208-138 93:35:88 t 


4919 


Dl le el lh ek ek le he ek le ek ek el Sek ed ek ke 
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3 


=PINIPIWIWNIWINININININININININININININININININ WES & NUNS IU BE AAAI BP PPP EE 


4 


BEGIN 


i gunit C1] EQ. 0 
LIBSSTOP ( COBS_EOFON_ACC ) ! Abort 
COBSSCONTROL_Z ( .UNIT, .KEY ) ; ! Return ta calling 
RETURN 0 ; i program. 
ELSE 
+ 


' 

i Escape Sequence as Terminator. COBSSCONTROL_KEY conver 
! terminator sequences to COBOL defined sequences and fil 
i im KEY parameter if enelassee is legal. 


ts 
ls 


BEGIN 
IF NOT ( COBSSCONTROL_KEY (TERM_PTR, .RAB CCOBS$SB Sve LEN 


j 
THEN 
BEGIN ! Error, illegal escape 
CPERSRRS PUT. BYTE ( RING_BELL, .FLAGS ) 3 ' sequence. 
END 
ELSE 
LEGAL = 1; 
END ; 
END ; ! End Loop 


1 
! VAX COBOL Version 1 / Version 3 interaction. 

: Determine if ADVANCING is requested. 

: Jf bit = 0 p2cr8 ancing. t 10 = 1 no oggenc ing, 

! Set (Gessas.p 0] - om, Scandia on bit 10, to flag to next COBOL 
! statement Phe advancing/no advancing .. required following this 
ACCEPT statement. 


(.FLAGS AND V_ADV) NEQ 0 


COBS$AB_PREVCO) = ACC_DNA 
ELSE 


+ 
a Echo carriage return to screen if advancing is called for. 


! Signal=- Do Not Advance 


BEGIN 
COBSSRMS PUT ers f 9 grele «FLAGS ) ; 
ore AB_PREVEOJ = ACC_A ! Signal- ADVance 


RETURN 1 ; 
END ; 


! End of routine COBS$FORMAT_FOUR 


01260 -BLKB 3 


COBR 15 CICOBACCEPT. yf 2:2 


Page 93 
° (16) 


9 
SACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement 18.53 -1984 23:54: AX-11 Bliss-32 V4.0-74 p 94 
itt COBSSFORMAT_FOUR = Format Four 12-808-198¢ 93:36:85 YOBRTL se COBAL CEST B42:2 29e 16) 
FFFFFFFE FFFFFFFE FFFFFEFE «FFERFFEF FEEEEEEE FEEFFEEE 01370 P.AAS: .LONG 1, <1, <1, <1, <1, <1, <1, <1 : | 
O1FC 00000 COBSSFORMAT_FOUR: | 
9 06 : Pn Save 2.83 ,R4,R5 RO.R7 RB : 4768 
§ boo090006 88 : $008 MOVAB LIBSSTOP, : | 
6 FBOC cr 1 MOV COBSSRMS_PUT BYTE, R6 : 
7 C 1 SUBL2 #24, SP : 
3 D4 0001 CLRL LEGAL : 4797. 
04 AE b0 1A MOVL #32, T + 6815 | 
08 AE BF AF : 1 MOVAB P.AAS, TMASK+4 : 4 16 
07 4 eo ei Bole ake RA ; 4822, 
; Rie fie ene | 
6 $ £B 00 F CALLS #3 COBSSAMS PUT _BYTE : 
1 5240 F %3C 000 3 1$: MOVZWL #21056, FUNC” VAL + 4838 | 
0 00000000" EF 9€ 000 MOVAB  XAB_ITMLST, SS$ITMBLKPTR + 46846 
0 04 99 CLRL (S$TTMBLKPTR) + : 
80 1 00 0 4 MOVL FUNC_VAL, (SSITMBLKPTR)+ : 
0 D4 0004 CLAL (SSITMBLKPTR)+ ; i 
80 00030020 F 00 004 MOVL #196640, (S$SITMBLKPTR)+ : | } 
0 8 AE p 0046 MOVL TMASK+4, (S$SITMBLKPTR)+ : | 
80 7C 0005 CLRO (SSITMBLKPTR) + : | : 
se “n 5 BS 9086 28: reveee Pee ® t aBeo 
13 5088 BEQL iS 5 i 
o0eB i 003A BRW 14$ : : 
52 000000006004 06 05D 2%: MOVL COBSSAL WRITE_RABCR3], RAB + 4855 : 
A OA : 006 MOVW #10, 32TRAB) : 4856 : 
6 OA oc A ; 906 MOV NEXT_CHAR, 36(RAB) > 4857 : 
Pe 8 0 6 BISB2 #16 : 4858 ‘ 
40 A2 00000000" i £ 000 V XABTRM, 64(RAB) : 4859 : 
¢ DD OOO7A 4$ PUSHL RAB : 4860 i 
000000006 00 FB 907¢ CALLS #1, SYSSGET F i 
000182DA_—saBF 0 p 00 CMPL = RO, #99034 ; i 
8 2 OOOBA BNEQ 5$ ; ‘ 
DD 0008C PUSHL RAB : i 
000000006 00 0} FB 295 CALLS #1, SYSSWAIT : : 
en a pee 
° e | 4 
000181C0 BF CMPL RO, #98752 : 4868 | 
? 0 iS BEQL ; | i 
0001827A BF p 0 A CMPL RO, #98938 ; 4869 | } 
000181C8 8F p 5 20 CMPL RO, #98760 ; 4870. ‘ 
1 B BEQL = 6 : i 
000181A8 8F s p B CMPL = RO,:« #98728 : 4871 
1 3 000C¢ BEQL ; 
0c A2 dd 000C PUSHL (RAB) > 4874, 
50 0D 000C PUSHL : 4873 | 
44 A2 9F 000C PUSHAB 68(RAB) : 
01 DD OOOCA PUSHL #1 ; 


SL —$———$—$_—_.-_ —— 
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9 
SACCEPT COBSACCEPT = VAX COBOL ACCEPT Statement ise -1 54: AX-11 Bliss-32 V 
ee $1) CORSE FORMAT FOUR - Format lon 12-808-1 She 93:36:55 YCOeRTL SRE COBAC 
000000006 Bf DD 000¢ PUSH #coBs ERRDURACC 
? 5 D CALLS #5, LIBSSTOP 
gc A D5 6$: MOVAB NEXT CHAR, TERM_PTR 
eS D CMPB 4(RAB), #1 
1 DD BNEQ 
Bay D MOVAB (RAB), TERM_PTR 
€ Ad 9A OOOE MOVZBL 1 (RAB) R 
6 EA bee > of 
0D 9 EC C RO, #13 
461 EF BNEQ =s«d:18 
5 oc AC Fl 7$: MOVL KEY, RO 
0 8B te ; FS nove aTERM_PTR, a4 (RO) 
0001827A BF 08 A ; FC 8$: CMPL B(RAB) #98938 
1D 01 BNEG 0$ 
05 ac 95 001 TSTB yNitet 
12 001 BNEQ $ 
000000006 BF ODD 91 PUSHL #COB$_EOFON_ACC 
? 1 re 111 CALLS #1, LIBSSTOP 
49 11 00114 BRB 17$ 
OC aC DD O16 9$: PUSHL KEY 
06 aC DD 0011 PUSHL UNIT 
0106 6 92 FB OOTIC CALLS #e COBSSCONTROL_2 
€ 11 00121 BRB 17$ 
0c aC DD 00123 10$: PUSHL KEY 
7E OF A2 9A 00126 MOVZBL 14(RAB), =(SP) 
0 Ar 9F O012A PUSHAB TER 
000000006 00 FB 012D CALLS #3, COBSSCONTROL_KEY 
08 0 €8 001 BLBS RO. 128 
4 DD 91 711%: PUSHL 
DD 00139 PUSHL a2 
66 FB 001 CALLS #2, COBSSRMS_PUT_BYTE 
D4 001 CLAL 6AL 
11 0014 BRB 
55 1 20 014 128: MOVL #1, LEGAL 
FFOE 3100145 13$: BRW 
05 54 OA 3 0148 14$: BBC #10, R4, 15$ 
68 5 014¢ MOVB #5, COBSS$AB_PREV 
A 11 OO14F BRB 16$ 
4 DD 00151 158 PUSHL  R4 
E D4 001 CLRL. = (SP) 
66 FB 001 CALLS #2, COBSSRMS_PUT_BYTE 
68 4 90 001 MOVE #4, COBSSAB_PREV 
1 00 00158 168: MOVL #1. R 
04 0015€ RET 
50 04 OO15F 17$:  CLRL RO 
4 00161 RET 


; Routine Size: 354 bytes, Routine Base: _COBSCODE + 1290 


. 
IG 
rm 
“ 
o 
- 
oO 
™~ 


END ' End of module COBSACCEPT 
ELUDOM -” 
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Library Statistics 


e: 4745 code + 449 data bytes 
ime: 1:09.6 


4 me: . 

; Elapsed Time: 5:34.6 
; Lines/CPU Min: 4290 

; ponenes/< Petras 29151 

; ry Used: 626 pages 
; cee ation Complete 


ACCEPT COBSACCEPT = vac ACCEPT Statement ee! K-11 Bliss-32 V4.0-74 
itt) COBSSFORMAT_FOUR - Format Four 18-se sep et 3: 76: 38 Hebante saeicosat cesT. B82; 32 
; PSECT SUMMARY 
3 Name Bytes Attributes 
: _COBSDATA 8 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON, PIC.ALIGN(2) 
> “COBSCODE 5106 NOVEC.NOWRT, RD; EXE. SHR, LCL, REL. CON, PIC.ALIGN(2) 


; maar wo oe Symbols weet en eo = Pages Proc essing 
; File Total Loaded Percent Mapped Time 

; ~$33sgbuaze: SYSLIBISTARLET.L32;1 9776 153 1 51 00:00.7 
H SSSDUA COBRTL.OBJJSMGL1B.L32;1 46 10 2 8 00:00.2 


COMMAND QUALIFIERS 
BLISS/CHECK= (FIELD. INITIAL OPTIMIZE) /NOTRACE/LIS#L1S8:COBACCEPT /0BJ=08N$ : COBACCEPT MSRC$: COBACCEPT/UPDATE=(ENH$: COBACCEPT 
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